| [628] | 1 | PSXLBLT ;BIR/HTW-CMOP Label Print..Trailer Docs ;[ 03/06/98 7:00 AM ]
|
|---|
| 2 | ;;2.0;CMOP;**1,13**;11 Apr 97
|
|---|
| 3 | DOC1 ; Print Multi-Rx documents
|
|---|
| 4 | I '$D(MRX) G FINAL
|
|---|
| 5 | S RXCT=0
|
|---|
| 6 | DOCNEW W ?54,PNAME," ",SSN
|
|---|
| 7 | W !?54,PADD1
|
|---|
| 8 | W !?54,PADD2
|
|---|
| 9 | I $G(PADD3)]"" W !?54,$G(PADD3)
|
|---|
| 10 | I $G(PADD4)]"" W !?54,$G(PADD4)
|
|---|
| 11 | W !,?54,"Please check prescriptions to be refilled"
|
|---|
| 12 | F I=1:1:3 S RXCT=$O(MRX(RXCT)) Q:'RXCT S MRX=MRX(RXCT) D
|
|---|
| 13 | .S RX=$P(MRX,U),TRUG=$P(MRX,U,2),REFREM=$P(MRX,U,3)
|
|---|
| 14 | .S EXPDT=$P(MRX,U,4),BAR=$P(MRX,U,5)
|
|---|
| 15 | .S EXPDT=$E(EXPDT,5,6)_"/"_$E(EXPDT,7,8)_"/"_$E(EXPDT,1,4)
|
|---|
| 16 | .W !,?54,"(____) ",TRUG
|
|---|
| 17 | .W !,?55,REFREM," ",?60,"Expires ",$G(EXPDT)," Rx# ",RX
|
|---|
| 18 | .I $G(PSXBAR) S X="S",X2=BAR W !,?55 S X1=$X W @IOBARON,X2,@IOBAROFF
|
|---|
| 19 | W !?54,"(______________________________________)"
|
|---|
| 20 | W !?55,"PATIENT'S SIGNATURE ",$E(DT,4,5),"/",$E(DT,6,7),"/",($E(DT,1,3)+1700)
|
|---|
| 21 | W @IOF
|
|---|
| 22 | I +$G(RXCT)>0 S RXCK=$O(MRX(RXCT)) I RXCK]"" K RXCK G DOCNEW
|
|---|
| 23 | K RXCT,RXCK,MRX,I,RX,TRUG,REFEM,EXPDT,X,X2
|
|---|
| 24 | FINAL ;Set up Suspense Notification
|
|---|
| 25 | I $D(SRX) D
|
|---|
| 26 | .S SUS(1)=SSN
|
|---|
| 27 | .S SUS(2)=PNAME
|
|---|
| 28 | .S SUS(3)=PADD1
|
|---|
| 29 | .S SUS(4)=PADD2,CT=5
|
|---|
| 30 | .I $G(ADDR3)]"" S SUS(5)=PADD3,CT=6
|
|---|
| 31 | .I $G(PADD4)]"" S SUS(6)=PADD4,CT=7
|
|---|
| 32 | .S SUS(CT)="",CT=CT+1
|
|---|
| 33 | .S SUS(CT)=" The following prescriptions will be",CT=CT+1
|
|---|
| 34 | .S SUS(CT)="mailed to you at a future date.",CT=CT+1
|
|---|
| 35 | .S SUS(CT)="",CT=CT+1
|
|---|
| 36 | .S SUS(CT)="Rx# Drug",CT=CT+1
|
|---|
| 37 | .S SUS(CT)="============================================",CT=CT+1
|
|---|
| 38 | .S SUS(CT)="",CT=CT+1
|
|---|
| 39 | .F XX=0:0 S XX=$O(SRX(XX)) Q:'XX D
|
|---|
| 40 | ..S SN=SRX(XX)
|
|---|
| 41 | ..S $P(PSXLGTH," ",(20-($L($P(SRX(XX),"^")))))=""
|
|---|
| 42 | ..S SUS(CT)=$P(SN,"^")_PSXLGTH_$P(SN,"^",2),CT=CT+1
|
|---|
| 43 | ..K PSXLGTH,SN
|
|---|
| 44 | ; Set up return address info for print
|
|---|
| 45 | S RAD($S($G(COPAYES):1,1:3))="Pharmacy Service (119)"
|
|---|
| 46 | S RAD($S($G(COPAYES):2,1:4))=SNAME
|
|---|
| 47 | S RAD($S($G(COPAYES):3,1:5))=SADD1
|
|---|
| 48 | S RAD($S($G(COPAYES):4,1:6))=SADD2
|
|---|
| 49 | S RAD($S($G(COPAYES):5,1:7))=SADD3
|
|---|
| 50 | I $G(COPAYES) F ZZZ=6:1:15 S RAD(ZZZ)=""
|
|---|
| 51 | I '$G(COPAYES) F ZZZ=8:1:17 S RAD(ZZZ)=""
|
|---|
| 52 | S RAD($S($G(COPAYES):16,1:18))="Use the label above to mail the computer"
|
|---|
| 53 | S RAD($S($G(COPAYES):17,1:19))="copies back to us. Apply enough postage"
|
|---|
| 54 | S RAD($S($G(COPAYES):18,1:20))="to your envelope to ensure delivery."
|
|---|
| 55 | ;Print Return Address(Left),REF/NOREF/COPAY narr(middle),SUS(right)
|
|---|
| 56 | S CT=1
|
|---|
| 57 | TOF W ?54,PNAME," ",SSN," ",$P(RNOW,"@"),!
|
|---|
| 58 | I $D(COPAYES),($G(PSXBAR)) S X="S",X1=$X,X2=SSN1 W ?54,@IOBARON,X2,@IOBAROFF,*13
|
|---|
| 59 | PRINT I $G(F1),($G(F2)),($G(F3)) G EXIT
|
|---|
| 60 | W $G(RAD(CT)) I '$O(RAD(CT)) S F1=1
|
|---|
| 61 | I $G(NARR(CT))="COPAY",('$D(COPAYES)) S NARR("COPAY")="NO",F2=1
|
|---|
| 62 | I $G(NARR("COPAY"))="NO" G SUSP
|
|---|
| 63 | I $G(NARR(CT))="COPAY" G SUSP
|
|---|
| 64 | W ?54,$G(NARR(CT)) I '$O(NARR(CT)) S F2=1
|
|---|
| 65 | SUSP I '$D(SUS) S CT=CT+1,F3=1 W ! G PRINT
|
|---|
| 66 | W ?102,$G(SUS(CT)),! I '$O(SUS(CT)) S F3=1
|
|---|
| 67 | S CT=CT+1
|
|---|
| 68 | G PRINT
|
|---|
| 69 | EXIT K DIWF,DIWL,DIWR,Q2,Z1,Z2,XX
|
|---|
| 70 | K PADD1,PADD2,PADD3,PCITY,PNAME,PSTATE,PTEMP,PZIP,MAILID,W1,W2,W3,MRX
|
|---|
| 71 | K QTY,ID,TRUG,SPARE,REFCT,REFREM,REFLST,RX,SIG,SIG1,ADDR(2),SRX,CLINIC
|
|---|
| 72 | K RXCT,RFTXT,PHYS,REGMAIL,CLKRPH,FDT,COPAY,RENW,CAP,ISD,EXPDT,PSTAT,ZZT
|
|---|
| 73 | K TAYS,WARN,ADDR(3),LOT,MFG,NURSE,SSN,TEMP,ZX,VERPHARM,RX1,BAR,SIGN,Z
|
|---|
| 74 | K RESET,SSN1,SUS,ISD1,RAD,F1,F2,F3,COPAYES,NARR("COPAY"),PADD4
|
|---|
| 75 | W @IOF
|
|---|
| 76 | Q
|
|---|
