- PSOARCRR ;BHAM ISC/LGH - Rx retrieve ; 07/07/92
- ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- U PSOAT W @%MT("REW")
- S PSOAPF=0
- R D PSOAT R X:DTIME G END:X="" G:X'="!" R
- PAR D PSOAT R X:DTIME G:'$T END G:$P(X,"^")=NM&($G(SS)=$P(X,"^",2)) PR G PAR
- END I $D(PSOAT) U IO(0) S IOP=PSOAT D ^%ZIS D ^%ZISC K IOP
- Q I $D(PSOAP) U IO(0) S IOP=PSOAP D ^%ZIS D ^%ZISC K IOP
- K PSOACPM,PSOACPL,PSOACPF,NM,T,RX,PSOAP,PSOAT,^TMP($J,"ZRX"),RA,RR,FFX,I,GD,DG,D,A
- Q
- PR ;patient read
- S T(1)=X D PSOAT G:PSOAEOT PAR R X:DTIME G:'$T END S T(2)=X,D=$P(T(2),"^",2),A=$P(T(2),"^",3),DG=$P(T(2),"^",4),GD=$P(T(2),"^",5)
- I D>0 F I=1:1:D D PSOAT G:PSOAEOT PAR R X:DTIME G:'$T END S T(2,I)=X
- I A>0 F I=1:1:A D PSOAT G:PSOAEOT PAR R X:DTIME G:'$T END S T(3,I)=X
- I DG>0 F I=1:1:DG D PSOAT G:PSOAEOT PAR R X:DTIME G:'$T END S T(4,I)=X
- I GD>0 F I=1:1:GD D PSOAT G:PSOAEOT PAR R X:DTIME G:'$T END S T(5,I)=X
- D:'PSOAPF DPR,HD1^PSOARCSV S PSOAPF=1 ;DISPLAY DEMO INFO
- RXR D PSOAT R X:DTIME G:'$T END G END:X="" I X="!" D PSOAT R X:DTIME G:'$T END G:$P(X,"^")'=NM END G PR
- S T(6)=X D PSOAT G:PSOAEOT PR R X:DTIME G:'$T END S T(10)=X D PSOAT G:PSOAEOT PR R X:DTIME G:'$T END S T(7)=X S RR=$P(T(7),"^",14),RA=$P(T(7),"^",15)
- I RR>0 F I=1:1:RR D PSOAT G:PSOAEOT PR R X:DTIME G:'$T END S T(8,I)=X
- I RA>0 F I=1:1:RA D PSOAT G:PSOAEOT PR R X:DTIME G:'$T END S T(9,I)=X
- D RXP W:$Y>(PSOACPL-15) @PSOACPF G RXR
- DPR U PSOAP W @PSOACPF,!!,NM,?55,"ID#: ",$P(T(1),"^",2),?75,"ELIG: ",$P(T(1),"^",3),!,$P(T(1),"^",4),?55,"DOB: ",$P(T(1),"^",5),?75,"PHONE: ",$P(T(1),"^",6)
- W !,$P(T(1),"^",7),!,$P(T(1),"^",8)," ",$P(T(1),"^",9)
- I +$P(T(1),"^",10) W !,"CANNOT USE SAFETY CAPS." I +$P(T(1),"^",11) W ?40,"DIALYSIS PATIENT"
- I $P(T(2),"^")'="" W !,$P(T(2),"^")
- W !,"DISABILITIES: " G MA:D'>0
- F I=1:1:D W:($Y+$L(T(2,I))+1)>PSOACPM !?15 W T(2,I),","
- MA W !!,"REACTIONS: ",$S(((A'>0)&(DG'>0)&(GD'>0)):"UNKNOWN",1:"")
- I A>0 F I=1:1:A W:($Y+$L(T(3,I))+1)>PSOACPM !?15 W T(3,I),","
- I DG>0 F I=1:1:DG W:($Y+$L(T(4,I))+1)>PSOACPM !?15 W T(4,I),","
- I GD>0 F I=1:1:GD W:($Y+$L(T(5,I))+1)>PSOACPM !?15 W T(5,I),","
- Q
- RXP U PSOAP W !!,"RX: ",$P(T(6),"^"),?20,$P(T(6),"^",2),?65,"TRADE NAME: ",$P(T(6),"^",3),?96,"QTY: ",$P(T(6),"^",4)," ",$P(T(6),"^",5)," DAY SUPPLY"
- W !?7,"SIG: ",T(10),!?4,"LATEST: ",$P(T(6),"^",7),?37,"# OF REFILLS: ",$P(T(6),"^",8)," REMAINING: ",$P(T(6),"^",9),?70,"PROVIDER:",$P(T(6),"^",10)
- W !?4,"ISSUED: ",$P(T(6),"^",11),?43,"CLINIC: ",$P(T(7),"^"),?71,"DIVISION: ",$P(T(7),"^",2),!?4,"LOGGED: ",$P(T(7),"^",3),?42,"ROUTING: ",$P(T(7),"^",4),?69,"CLERK CODE: ",$P(T(7),"^",5)
- W !?3,"EXPIRES: ",$P(T(7),"^",6),?46,"CAP: ",$P(T(7),"^",7),?73,"STATUS: ",$P(T(7),"^",8),!,?4,"FILLED: ",$P(T(7),"^",9),?24,"PHARMACIST: ",$P(T(7),"^",10),?56,"LOT #: ",$P(T(7),"^",11),?74,"QTY: ",$P(T(7),"^",12)
- I $P(T(7),"^",13)]"" W !?3,"REMARKS: ",$P(T(7),"^",13)
- G:RR'>0 ACT D HEAD
- F I=1:1:RR W !,I,?3,$P(T(8,I),"^"),?14,$P(T(8,I),"^",2),?27,$P(T(8,I),"^",3),?32,$P(T(8,I),"^",4),?40,$P(T(8,I),"^",5),?52,$P(T(8,I),"^",6),?70,$P(T(8,I),"^",7) W:$P(T(8,I),"^",8)'="" !?5,"REMARKS: ",$P(T(8,I),"^",8)
- W !
- ACT Q:RA'>0 D H1 F I=1:2:RA D ACT1
- K T(9) Q
- ACT1 W !,I,?3,$P(T(9,I),"^"),?14,$P(T(9,I),"^",2),?25,$P(T(9,I),"^",3),?35,$P(T(9,I),"^",4) G:'$D(T(9,I+1)) REM
- W ?60,I+1,?63,$P(T(9,I+1),"^"),?74,$P(T(9,I+1),"^",2),?85,$P(T(9,I+1),"^",3),?95,$P(T(9,I+1),"^",4)
- REM W ! I $P(T(9,I),"^",5)]"" W ?5,"COMMENT: ",$P(T(9,I),"^",5)
- I $D(T(9,I+1)) W:$P(T(9,I+1),"^",5)]"" ?65,"COMMENT: ",$P(T(9,I+1),"^",5)
- Q
- PSOAT ;check for eot, return psoaeot=1 if found
- U PSOAT S PSOAEOT=0 X ^%ZOSF("EOT") I Y D EOT S PSOAEOT=1
- U PSOAT Q
- EOT U IO(0) W !!?5,"** End of tape detected **",!?5,"After current tape rewinds, mount next tape" U PSOAT W @%MT("REW")
- READ U IO(0) W !?5,"Type <CR> to continue" R XX:DTIME I '$T W $C(7) G READ
- W !!,"continuing" S PSOATNM=PSOATNM+1
- Q
- HEAD D:$Y>(PSOACPL-20) HD1^PSOARCSV
- W !,"#",?3,"LOG DATE",?14,"REFILL DATE",?27,"QTY",?32,"ROUTING",?40,"LOT #",?52,"PHARMACIST",?70,"DIVISION",! F I=1:1:79 W "="
- S FFX=0 Q
- H1 D:$Y>(PSOACPL-20) HD1^PSOARCSV
- W !!,"ACTIVITY LOG:",!,"#",?3,"DATE",?14,"REASON",?25,"RX REF",?35,"SECURITY",?60,"#",?63,"DATE",?74,"REASON",?85,"RX REF",?95,"SECURITY",! F I=1:1:55 W "="
- W ?60 F I=1:1:60 W "="
- Q
- PSOARCRR ;BHAM ISC/LGH - Rx retrieve ; 07/07/92
- +1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- +2 USE PSOAT
- WRITE @%MT("REW")
- +3 SET PSOAPF=0
- R DO PSOAT
- READ X:DTIME
- IF X=""
- GOTO END
- IF X'="!"
- GOTO R
- PAR DO PSOAT
- READ X:DTIME
- IF '$TEST
- GOTO END
- IF $PIECE(X,"^")=NM&($GET(SS)=$PIECE(X,"^",2))
- GOTO PR
- GOTO PAR
- END IF $DATA(PSOAT)
- USE IO(0)
- SET IOP=PSOAT
- DO ^%ZIS
- DO ^%ZISC
- KILL IOP
- Q IF $DATA(PSOAP)
- USE IO(0)
- SET IOP=PSOAP
- DO ^%ZIS
- DO ^%ZISC
- KILL IOP
- +1 KILL PSOACPM,PSOACPL,PSOACPF,NM,T,RX,PSOAP,PSOAT,^TMP($JOB,"ZRX"),RA,RR,FFX,I,GD,DG,D,A
- +2 QUIT
- PR ;patient read
- +1 SET T(1)=X
- DO PSOAT
- IF PSOAEOT
- GOTO PAR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(2)=X
- SET D=$PIECE(T(2),"^",2)
- SET A=$PIECE(T(2),"^",3)
- SET DG=$PIECE(T(2),"^",4)
- SET GD=$PIECE(T(2),"^",5)
- +2 IF D>0
- FOR I=1:1:D
- DO PSOAT
- IF PSOAEOT
- GOTO PAR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(2,I)=X
- +3 IF A>0
- FOR I=1:1:A
- DO PSOAT
- IF PSOAEOT
- GOTO PAR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(3,I)=X
- +4 IF DG>0
- FOR I=1:1:DG
- DO PSOAT
- IF PSOAEOT
- GOTO PAR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(4,I)=X
- +5 IF GD>0
- FOR I=1:1:GD
- DO PSOAT
- IF PSOAEOT
- GOTO PAR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(5,I)=X
- +6 ;DISPLAY DEMO INFO
- IF 'PSOAPF
- DO DPR
- DO HD1^PSOARCSV
- SET PSOAPF=1
- RXR DO PSOAT
- READ X:DTIME
- IF '$TEST
- GOTO END
- IF X=""
- GOTO END
- IF X="!"
- DO PSOAT
- READ X:DTIME
- IF '$TEST
- GOTO END
- IF $PIECE(X,"^")'=NM
- GOTO END
- GOTO PR
- +1 SET T(6)=X
- DO PSOAT
- IF PSOAEOT
- GOTO PR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(10)=X
- DO PSOAT
- IF PSOAEOT
- GOTO PR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(7)=X
- SET RR=$PIECE(T(7),"^",14)
- SET RA=$PIECE(T(7),"^",15)
- +2 IF RR>0
- FOR I=1:1:RR
- DO PSOAT
- IF PSOAEOT
- GOTO PR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(8,I)=X
- +3 IF RA>0
- FOR I=1:1:RA
- DO PSOAT
- IF PSOAEOT
- GOTO PR
- READ X:DTIME
- IF '$TEST
- GOTO END
- SET T(9,I)=X
- +4 DO RXP
- IF $Y>(PSOACPL-15)
- WRITE @PSOACPF
- GOTO RXR
- DPR USE PSOAP
- WRITE @PSOACPF,!!,NM,?55,"ID#: ",$PIECE(T(1),"^",2),?75,"ELIG: ",$PIECE(T(1),"^",3),!,$PIECE(T(1),"^",4),?55,"DOB: ",$PIECE(T(1),"^",5),?75,"PHONE: ",$PIECE(T(1),"^",6)
- +1 WRITE !,$PIECE(T(1),"^",7),!,$PIECE(T(1),"^",8)," ",$PIECE(T(1),"^",9)
- +2 IF +$PIECE(T(1),"^",10)
- WRITE !,"CANNOT USE SAFETY CAPS."
- IF +$PIECE(T(1),"^",11)
- WRITE ?40,"DIALYSIS PATIENT"
- +3 IF $PIECE(T(2),"^")'=""
- WRITE !,$PIECE(T(2),"^")
- +4 WRITE !,"DISABILITIES: "
- IF D'>0
- GOTO MA
- +5 FOR I=1:1:D
- IF ($Y+$LENGTH(T(2,I))+1)>PSOACPM
- WRITE !?15
- WRITE T(2,I),","
- MA WRITE !!,"REACTIONS: ",$SELECT(((A'>0)&(DG'>0)&(GD'>0)):"UNKNOWN",1:"")
- +1 IF A>0
- FOR I=1:1:A
- IF ($Y+$LENGTH(T(3,I))+1)>PSOACPM
- WRITE !?15
- WRITE T(3,I),","
- +2 IF DG>0
- FOR I=1:1:DG
- IF ($Y+$LENGTH(T(4,I))+1)>PSOACPM
- WRITE !?15
- WRITE T(4,I),","
- +3 IF GD>0
- FOR I=1:1:GD
- IF ($Y+$LENGTH(T(5,I))+1)>PSOACPM
- WRITE !?15
- WRITE T(5,I),","
- +4 QUIT
- RXP USE PSOAP
- WRITE !!,"RX: ",$PIECE(T(6),"^"),?20,$PIECE(T(6),"^",2),?65,"TRADE NAME: ",$PIECE(T(6),"^",3),?96,"QTY: ",$PIECE(T(6),"^",4)," ",$PIECE(T(6),"^",5)," DAY SUPPLY"
- +1 WRITE !?7,"SIG: ",T(10),!?4,"LATEST: ",$PIECE(T(6),"^",7),?37,"# OF REFILLS: ",$PIECE(T(6),"^",8)," REMAINING: ",$PIECE(T(6),"^",9),?70,"PROVIDER:",$PIECE(T(6),"^",10)
- +2 WRITE !?4,"ISSUED: ",$PIECE(T(6),"^",11),?43,"CLINIC: ",$PIECE(T(7),"^"),?71,"DIVISION: ",$PIECE(T(7),"^",2),!?4,"LOGGED: ",$PIECE(T(7),"^",3),?42,"ROUTING: ",$PIECE(T(7),"^",4),?69,"CLERK CODE: ",$PIECE(T(7),"^",5)
- +3 WRITE !?3,"EXPIRES: ",$PIECE(T(7),"^",6),?46,"CAP: ",$PIECE(T(7),"^",7),?73,"STATUS: ",$PIECE(T(7),"^",8),!,?4,"FILLED: ",$PIECE(T(7),"^",9),?24,"PHARMACIST: ",$PIECE(T(7),"^",10),?56,"LOT #: ",$PIECE(T(7),"^",11),?74,"QTY: ",$PIECE(T(7),"^",12
- )
- +4 IF $PIECE(T(7),"^",13)]""
- WRITE !?3,"REMARKS: ",$PIECE(T(7),"^",13)
- +5 IF RR'>0
- GOTO ACT
- DO HEAD
- +6 FOR I=1:1:RR
- WRITE !,I,?3,$PIECE(T(8,I),"^"),?14,$PIECE(T(8,I),"^",2),?27,$PIECE(T(8,I),"^",3),?32,$PIECE(T(8,I),"^",4),?40,$PIECE(T(8,I),"^",5),?52,$PIECE(T(8,I),"^",6),?70,$PIECE(T(8,I),"^",7)
- IF $PIECE(T(8,I),"^",8)'=""
- WRITE !?5,"REMARKS: ",$PIECE(T(8,I),"^",8)
- +7 WRITE !
- ACT IF RA'>0
- QUIT
- DO H1
- FOR I=1:2:RA
- DO ACT1
- +1 KILL T(9)
- QUIT
- ACT1 WRITE !,I,?3,$PIECE(T(9,I),"^"),?14,$PIECE(T(9,I),"^",2),?25,$PIECE(T(9,I),"^",3),?35,$PIECE(T(9,I),"^",4)
- IF '$DATA(T(9,I+1))
- GOTO REM
- +1 WRITE ?60,I+1,?63,$PIECE(T(9,I+1),"^"),?74,$PIECE(T(9,I+1),"^",2),?85,$PIECE(T(9,I+1),"^",3),?95,$PIECE(T(9,I+1),"^",4)
- REM WRITE !
- IF $PIECE(T(9,I),"^",5)]""
- WRITE ?5,"COMMENT: ",$PIECE(T(9,I),"^",5)
- +1 IF $DATA(T(9,I+1))
- IF $PIECE(T(9,I+1),"^",5)]""
- WRITE ?65,"COMMENT: ",$PIECE(T(9,I+1),"^",5)
- +2 QUIT
- PSOAT ;check for eot, return psoaeot=1 if found
- +1 USE PSOAT
- SET PSOAEOT=0
- XECUTE ^%ZOSF("EOT")
- IF Y
- DO EOT
- SET PSOAEOT=1
- +2 USE PSOAT
- QUIT
- EOT USE IO(0)
- WRITE !!?5,"** End of tape detected **",!?5,"After current tape rewinds, mount next tape"
- USE PSOAT
- WRITE @%MT("REW")
- READ USE IO(0)
- WRITE !?5,"Type <CR> to continue"
- READ XX:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- GOTO READ
- +1 WRITE !!,"continuing"
- SET PSOATNM=PSOATNM+1
- +2 QUIT
- HEAD IF $Y>(PSOACPL-20)
- DO HD1^PSOARCSV
- +1 WRITE !,"#",?3,"LOG DATE",?14,"REFILL DATE",?27,"QTY",?32,"ROUTING",?40,"LOT #",?52,"PHARMACIST",?70,"DIVISION",!
- FOR I=1:1:79
- WRITE "="
- +2 SET FFX=0
- QUIT
- H1 IF $Y>(PSOACPL-20)
- DO HD1^PSOARCSV
- +1 WRITE !!,"ACTIVITY LOG:",!,"#",?3,"DATE",?14,"REASON",?25,"RX REF",?35,"SECURITY",?60,"#",?63,"DATE",?74,"REASON",?85,"RX REF",?95,"SECURITY",!
- FOR I=1:1:55
- WRITE "="
- +2 WRITE ?60
- FOR I=1:1:60
- WRITE "="
- +3 QUIT
