| 1 | PSXLBL1 ;BIR/HTW,BAB-CMOP Host Label Print..Set Up Variables ; [ 07/21/98 7:27 AM ]
|
|---|
| 2 | ;;2.0;CMOP;**13,18**;11 Apr 97
|
|---|
| 3 | S ^PSX(553,1,"P")="R"
|
|---|
| 4 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 5 | A S B="|",S="\S\",F="\F\",R="\R\",A="" S X=158 X ^%ZOSF("RM")
|
|---|
| 6 | NTE S ^PSX(552.1,"APR",BATREF)=""
|
|---|
| 7 | F G=0:0 S G=$O(^PSX(552.1,N514,"S",G)) Q:'G D
|
|---|
| 8 | .S NTE=^PSX(552.1,N514,"S",G,0),NZ=$P(NTE,B,2)
|
|---|
| 9 | .I NZ=1 S SITE=+$P(NTE,B,4),SNAME=$P($P(NTE,B,4),S,2)
|
|---|
| 10 | .I S SADD=$P(NTE,F,2),L=1,STEL=$P(NTE,F,3)
|
|---|
| 11 | .I F M="SADD1","SADD2","SCITY","SSTATE","SZIP" S @M=$P(SADD,S,L),L=L+1
|
|---|
| 12 | .I NZ=2 S Q=$S($G(Q):Q+1,1:1),N=$P(NTE,B,4) D STRIP S N2(Q)=N Q
|
|---|
| 13 | .I NZ=3 S V=$S($G(V):V+1,1:1),N=$P(NTE,B,4) D STRIP S N3(V)=N Q
|
|---|
| 14 | .I NZ=4 S C=$S($G(C):C+1,1:1),N=$P(NTE,B,4) D STRIP S N4(C)=N Q
|
|---|
| 15 | S SADD3=SCITY_" "_SSTATE_" "_SZIP I $G(SADD2)="" S SADD2=SADD3,SADD3=""
|
|---|
| 16 | ;Combine REFILL/NON-REFILL/COPAY NARRATIVES
|
|---|
| 17 | S CT=1
|
|---|
| 18 | F P=0:0 S P=$O(N2(P)) Q:'P S NARR(CT)=N2(P),CT=CT+1
|
|---|
| 19 | S NARR(CT)="" S CT=CT+1
|
|---|
| 20 | F P=0:0 S P=$O(N3(P)) Q:'P S NARR(CT)=N3(P),CT=CT+1
|
|---|
| 21 | S NARR(CT)="COPAY" S CT=CT+1
|
|---|
| 22 | F P=0:0 S P=$O(N4(P)) Q:'P S NARR(CT)=N4(P),CT=CT+1
|
|---|
| 23 | K Q,V,C,L,N,NTE,NZ,CT,N2,N3,N4
|
|---|
| 24 | G:$G(PSXBLR) PRINT^PSXLBLU
|
|---|
| 25 | S A1=PSXBEG-1
|
|---|
| 26 | F S A1=$O(^PSX(552.2,PSXREF,BATREF,A1)) Q:'A1!(A1>PSXEND) S ZA2=A1-1 D MAIN
|
|---|
| 27 | END G F514^PSXLBLU
|
|---|
| 28 | Q
|
|---|
| 29 | 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
|
|---|
| 30 | Q
|
|---|
| 31 | RX F C=1:0 S C=$O(^PSX(552.2,ZA2,"T",C)) Q:'C S J=^(C,0) D
|
|---|
| 32 | .I $P(^PSX(552.2,ZA2,0),"^")'[BATREF Q
|
|---|
| 33 | .S J1=$P(J,B),J2=$P(J,B,2)
|
|---|
| 34 | .I J1="PID" D Q
|
|---|
| 35 | ..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)
|
|---|
| 36 | ..S SSN=S1_"-"_S2_"-"_S3
|
|---|
| 37 | ..S PNAME=$TR($P(J,B,6),"^",",")
|
|---|
| 38 | ..S PA=$P(J,B,12),L=1
|
|---|
| 39 | ..F M="PADD1","PADD2","PCITY","PSTATE","PZIP" S @M=$P(PA,U,L),L=L+1
|
|---|
| 40 | ..K S1,S2,S3,L,PA,M
|
|---|
| 41 | .I J2=5 S C5=$S($G(C5):C5+1,1:1) D STRIPF S MRX(C5)=$P(P2,B,4) K P2 Q
|
|---|
| 42 | .I J2=6 S C6=$S($G(C6):C6+1,1:1) D STRIPF S SRX(C6)=$P(P2,B,4) K P2 Q
|
|---|
| 43 | .I J1="RX1" D Q
|
|---|
| 44 | ..S CRX=$S($G(CRX):CRX+1,1:1),RX(CRX)=$P(J,B,13)
|
|---|
| 45 | ..F X=15,20,21,22,25,26,27,31 S RX(CRX)=RX(CRX)_U_$P(J,B,X)
|
|---|
| 46 | ..K X Q
|
|---|
| 47 | .I J1="ZX1" K CNTE D Q
|
|---|
| 48 | ..S ZX(CRX)=$P(J,B,2) F X=3:1:19 S ZX(CRX)=ZX(CRX)_U_$P(J,B,X)
|
|---|
| 49 | ..K X
|
|---|
| 50 | .I J2=7 S CNTE=$S($G(CNTE):CNTE+1,1:2) S RX(CRX,CNTE)=$P(J,B,4) Q
|
|---|
| 51 | .I J2=8 S TEMP=$P(J,B,4) D
|
|---|
| 52 | ..S PTEMP=$S($P(TEMP,F)=1:$P(TEMP,F,2),1:"")
|
|---|
| 53 | ..S PADD3=$P($G(TEMP),F,3)
|
|---|
| 54 | ..I $G(PTEMP) S PTEMP=$E(PTEMP,5,6)_"/"_$E(PTEMP,7,8)_"/"_$E(PTEMP,1,4)
|
|---|
| 55 | ..K TEMP
|
|---|
| 56 | PADD I $G(PADD2)="" S PADD2=PCITY_", "_PSTATE_" "_PZIP G CLN1
|
|---|
| 57 | I $G(PADD3)="" S PADD3=PCITY_", "_PSTATE_" "_PZIP G CLN1
|
|---|
| 58 | S PADD4=PCITY_", "_PSTATE_" "_PZIP G CLN1
|
|---|
| 59 | CLN1 ;
|
|---|
| 60 | K C5,C6,CRX,P,P1,P2,J,J1,J2,G,SADD,M,L,Q,V,C,N,S1,S2,S3,PA,X
|
|---|
| 61 | K CNTE,NTE,CT
|
|---|
| 62 | SET F C=0:0 S C=$O(RX(C)) Q:'C D I '$G(RESET)!($G(RESET)<C)!($G(RESET)="TOP") D ^PSXLBL2
|
|---|
| 63 | .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
|
|---|
| 64 | .S Z50=$O(^PSDRUG("AQ1",ID,"")) I $G(Z50) D
|
|---|
| 65 | ..S Z1=$P($G(^PSDRUG(Z50,"ND")),"^"),Z2=$P($G(^("ND")),"^",3) I $G(Z2) D
|
|---|
| 66 | ...;S VADU=$P($G(^PSNDF(Z1,5,Z2,2)),"^",4)
|
|---|
| 67 | ...S ZZX=$$PROD2^PSNAPIS(Z1,Z2),VADU=$P(ZZX,"^",4) K ZZX
|
|---|
| 68 | .S ISD1=ISD
|
|---|
| 69 | .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
|
|---|
| 70 | .I $G(REFLST)>0 S REFLST=$E(REFLST,5,6)_"/"_$E(REFLST,7,8)_"/"_$E(REFLST,1,4)
|
|---|
| 71 | .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
|
|---|
| 72 | .F C1="PHYS","REGMAIL","CLKRPH","FDT","COPAY","RENW" S @C1=$P(ZX(C),U,C2),C2=C2+1
|
|---|
| 73 | .F C1="CAP","TAYS","Z","BAR","WARN","PSTAT","CLINIC" S @C1=$P(ZX(C),U,C2),C2=C2+1
|
|---|
| 74 | .S FDT=FDT-17000000 S:FDT'>0 FDT="" I FDT>0 S Y=FDT X ^DD("DD") S FDT=Y
|
|---|
| 75 | .S CLERK=$P($P(CLKRPH,"/"),"(",2),VERPHARM=$P($P(CLKRPH,"/",2),")") I $G(WARN)]"" S WARN=$TR(WARN,"~",",")
|
|---|
| 76 | .S RFTXT=$P($P(RFTXT,"(",2),")"),R=$P(RFTXT,"of"),V=$P(RFTXT,"of",2),RFTXT=R_" of "_V
|
|---|
| 77 | .S COPAY=$S($G(COPAY)<1:"NO COPAY",1:"COPAY") I COPAY="COPAY" S COPAY(C)=RX_U_TRUG_U_TAYS,COPAYES=1
|
|---|
| 78 | .F N=0:0 S N=$O(RX(C,N)) Q:'N S SIGN=N
|
|---|
| 79 | .I $G(RX(C,SIGN))["Exp:" S NURSE=$G(RX(C,SIGN)) K RX(C,SIGN),SIGN,N
|
|---|
| 80 | .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
|
|---|
| 81 | .F N=0:0 S N=$O(^UTILITY($J,"W",1,N)) Q:'N S SIG(N)=^(N,0),SIGN=N
|
|---|
| 82 | .K ^UTILITY($J),N,SPARE,Z,Y,R,V,N,N1,Z50,Z1,Z2
|
|---|
| 83 | Q
|
|---|
| 84 | STRIPF S P=$L(J,"\F\"),P2="" F I=1:1:P S P1=$P(J,"\F\",I),P2=P2_U_P1
|
|---|
| 85 | K P,P1,I Q
|
|---|
| 86 | STRIP Q:N'["\R\" S P=$L(N,"\R\"),P2="" F I=1:1:P S P1=$P(N,"\R\",I),P2=P2_" "_P1
|
|---|
| 87 | S N=P2 K P,P1,P2
|
|---|
| 88 | Q
|
|---|
