89 lines
4.4 KiB
Mathematica
89 lines
4.4 KiB
Mathematica
PSXLBL1 ;BIR/HTW,BAB-CMOP Host Label Print..Set Up Variables ; [ 07/21/98 7:27 AM ]
|
|
;;2.0;CMOP;**13,18**;11 Apr 97
|
|
S ^PSX(553,1,"P")="R"
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
A S B="|",S="\S\",F="\F\",R="\R\",A="" S X=158 X ^%ZOSF("RM")
|
|
NTE S ^PSX(552.1,"APR",BATREF)=""
|
|
F G=0:0 S G=$O(^PSX(552.1,N514,"S",G)) Q:'G D
|
|
.S NTE=^PSX(552.1,N514,"S",G,0),NZ=$P(NTE,B,2)
|
|
.I NZ=1 S SITE=+$P(NTE,B,4),SNAME=$P($P(NTE,B,4),S,2)
|
|
.I S SADD=$P(NTE,F,2),L=1,STEL=$P(NTE,F,3)
|
|
.I F M="SADD1","SADD2","SCITY","SSTATE","SZIP" S @M=$P(SADD,S,L),L=L+1
|
|
.I NZ=2 S Q=$S($G(Q):Q+1,1:1),N=$P(NTE,B,4) D STRIP S N2(Q)=N Q
|
|
.I NZ=3 S V=$S($G(V):V+1,1:1),N=$P(NTE,B,4) D STRIP S N3(V)=N Q
|
|
.I NZ=4 S C=$S($G(C):C+1,1:1),N=$P(NTE,B,4) D STRIP S N4(C)=N Q
|
|
S SADD3=SCITY_" "_SSTATE_" "_SZIP I $G(SADD2)="" S SADD2=SADD3,SADD3=""
|
|
;Combine REFILL/NON-REFILL/COPAY NARRATIVES
|
|
S CT=1
|
|
F P=0:0 S P=$O(N2(P)) Q:'P S NARR(CT)=N2(P),CT=CT+1
|
|
S NARR(CT)="" S CT=CT+1
|
|
F P=0:0 S P=$O(N3(P)) Q:'P S NARR(CT)=N3(P),CT=CT+1
|
|
S NARR(CT)="COPAY" S CT=CT+1
|
|
F P=0:0 S P=$O(N4(P)) Q:'P S NARR(CT)=N4(P),CT=CT+1
|
|
K Q,V,C,L,N,NTE,NZ,CT,N2,N3,N4
|
|
G:$G(PSXBLR) PRINT^PSXLBLU
|
|
S A1=PSXBEG-1
|
|
F S A1=$O(^PSX(552.2,PSXREF,BATREF,A1)) Q:'A1!(A1>PSXEND) S ZA2=A1-1 D MAIN
|
|
END G F514^PSXLBLU
|
|
Q
|
|
MAIN F S ZA2=$O(^PSX(552.2,ZA2)) Q:'ZA2!(ZA2>A1) D RX,^PSXLBLT S DA=ZA2,DR="1////5",DIE="^PSX(552.2," D ^DIE K DIE,DA,DR
|
|
Q
|
|
RX F C=1:0 S C=$O(^PSX(552.2,ZA2,"T",C)) Q:'C S J=^(C,0) D
|
|
.I $P(^PSX(552.2,ZA2,0),"^")'[BATREF Q
|
|
.S J1=$P(J,B),J2=$P(J,B,2)
|
|
.I J1="PID" D Q
|
|
..S (SSN,SSN1)=$E($P(J,B,4),1,9),S1=$E(SSN,1,3),S2=$E(SSN,4,5),S3=$E(SSN,6,9)
|
|
..S SSN=S1_"-"_S2_"-"_S3
|
|
..S PNAME=$TR($P(J,B,6),"^",",")
|
|
..S PA=$P(J,B,12),L=1
|
|
..F M="PADD1","PADD2","PCITY","PSTATE","PZIP" S @M=$P(PA,U,L),L=L+1
|
|
..K S1,S2,S3,L,PA,M
|
|
.I J2=5 S C5=$S($G(C5):C5+1,1:1) D STRIPF S MRX(C5)=$P(P2,B,4) K P2 Q
|
|
.I J2=6 S C6=$S($G(C6):C6+1,1:1) D STRIPF S SRX(C6)=$P(P2,B,4) K P2 Q
|
|
.I J1="RX1" D Q
|
|
..S CRX=$S($G(CRX):CRX+1,1:1),RX(CRX)=$P(J,B,13)
|
|
..F X=15,20,21,22,25,26,27,31 S RX(CRX)=RX(CRX)_U_$P(J,B,X)
|
|
..K X Q
|
|
.I J1="ZX1" K CNTE D Q
|
|
..S ZX(CRX)=$P(J,B,2) F X=3:1:19 S ZX(CRX)=ZX(CRX)_U_$P(J,B,X)
|
|
..K X
|
|
.I J2=7 S CNTE=$S($G(CNTE):CNTE+1,1:2) S RX(CRX,CNTE)=$P(J,B,4) Q
|
|
.I J2=8 S TEMP=$P(J,B,4) D
|
|
..S PTEMP=$S($P(TEMP,F)=1:$P(TEMP,F,2),1:"")
|
|
..S PADD3=$P($G(TEMP),F,3)
|
|
..I $G(PTEMP) S PTEMP=$E(PTEMP,5,6)_"/"_$E(PTEMP,7,8)_"/"_$E(PTEMP,1,4)
|
|
..K TEMP
|
|
PADD I $G(PADD2)="" S PADD2=PCITY_", "_PSTATE_" "_PZIP G CLN1
|
|
I $G(PADD3)="" S PADD3=PCITY_", "_PSTATE_" "_PZIP G CLN1
|
|
S PADD4=PCITY_", "_PSTATE_" "_PZIP G CLN1
|
|
CLN1 ;
|
|
K C5,C6,CRX,P,P1,P2,J,J1,J2,G,SADD,M,L,Q,V,C,N,S1,S2,S3,PA,X
|
|
K CNTE,NTE,CT
|
|
SET F C=0:0 S C=$O(RX(C)) Q:'C D I '$G(RESET)!($G(RESET)<C)!($G(RESET)="TOP") D ^PSXLBL2
|
|
.S C2=1 F C1="QTY","ID","TRUG","SPARE","REFCT","ISD","REFREM","EXPDT","REFLST","RX","SIG" S @C1=$P(RX(C),U,C2),C2=C2+1
|
|
.S Z50=$O(^PSDRUG("AQ1",ID,"")) I $G(Z50) D
|
|
..S Z1=$P($G(^PSDRUG(Z50,"ND")),"^"),Z2=$P($G(^("ND")),"^",3) I $G(Z2) D
|
|
...;S VADU=$P($G(^PSNDF(Z1,5,Z2,2)),"^",4)
|
|
...S ZZX=$$PROD2^PSNAPIS(Z1,Z2),VADU=$P(ZZX,"^",4) K ZZX
|
|
.S ISD1=ISD
|
|
.F ZZT="ISD","EXPDT" S @ZZT=@ZZT-17000000 S:@ZZT'>0 @ZZT="" I +(@ZZT)>0 S:ZZT="EXPDT" EXPDT1=EXPDT S Y=@ZZT X ^DD("DD") S @ZZT=Y K Y
|
|
.I $G(REFLST)>0 S REFLST=$E(REFLST,5,6)_"/"_$E(REFLST,7,8)_"/"_$E(REFLST,1,4)
|
|
.S RX(C,1)=SIG K SIG S C2=1 F C1="RX1","SITE","MAILID","Z","RXCT","RFTXT" S @C1=$P(ZX(C),U,C2),C2=C2+1
|
|
.F C1="PHYS","REGMAIL","CLKRPH","FDT","COPAY","RENW" S @C1=$P(ZX(C),U,C2),C2=C2+1
|
|
.F C1="CAP","TAYS","Z","BAR","WARN","PSTAT","CLINIC" S @C1=$P(ZX(C),U,C2),C2=C2+1
|
|
.S FDT=FDT-17000000 S:FDT'>0 FDT="" I FDT>0 S Y=FDT X ^DD("DD") S FDT=Y
|
|
.S CLERK=$P($P(CLKRPH,"/"),"(",2),VERPHARM=$P($P(CLKRPH,"/",2),")") I $G(WARN)]"" S WARN=$TR(WARN,"~",",")
|
|
.S RFTXT=$P($P(RFTXT,"(",2),")"),R=$P(RFTXT,"of"),V=$P(RFTXT,"of",2),RFTXT=R_" of "_V
|
|
.S COPAY=$S($G(COPAY)<1:"NO COPAY",1:"COPAY") I COPAY="COPAY" S COPAY(C)=RX_U_TRUG_U_TAYS,COPAYES=1
|
|
.F N=0:0 S N=$O(RX(C,N)) Q:'N S SIGN=N
|
|
.I $G(RX(C,SIGN))["Exp:" S NURSE=$G(RX(C,SIGN)) K RX(C,SIGN),SIGN,N
|
|
.S Y=DT X ^DD("DD") S TODAY=Y K ^UTILITY($J,"W") S DIWL=1,DIWR=48,DIWF="C48" F N=0:0 S N=$O(RX(C,N)) Q:'N S X=RX(C,N) D ^DIWP
|
|
.F N=0:0 S N=$O(^UTILITY($J,"W",1,N)) Q:'N S SIG(N)=^(N,0),SIGN=N
|
|
.K ^UTILITY($J),N,SPARE,Z,Y,R,V,N,N1,Z50,Z1,Z2
|
|
Q
|
|
STRIPF S P=$L(J,"\F\"),P2="" F I=1:1:P S P1=$P(J,"\F\",I),P2=P2_U_P1
|
|
K P,P1,I Q
|
|
STRIP Q:N'["\R\" S P=$L(N,"\R\"),P2="" F I=1:1:P S P1=$P(N,"\R\",I),P2=P2_" "_P1
|
|
S N=P2 K P,P1,P2
|
|
Q
|