- PSOARCF2 ;BHAM ISC/LGH,LC - RX RETRIEVE ; 07/07/92
- ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- U PSOAT S PSORWND=$$REWIND^%ZIS(PSOAIO,PSOAIOT,PSOAPAR) I $G(PSORWND)=0 U IO(0) W !!,"HFS file failed to rewind" G END
- 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,PSOAP,PSOAT,^TMP($J,"ZRX"),A,DG,GD,I,PSOACDS,PSOAEOT,Y,RX,%MT,D,PSOAPF,PSOATNM,X,XX
- K ^TMP($J,"ZRX"),NM,SS,X,XX,XNM,XSS,T,TZ,A,DG,GD,I,Y,RX,D
- Q
- PR ;PATIENT READ
- S T(1)=X D READT 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>"" F I=1:1:D D READT S T(2,I)=X
- I A>"" F I=1:1:A D READT S T(3,I)=X
- I DG>"" F I=1:1:DG D READT S T(4,I)=X
- I GD>"" F I=1:1:GD D READT S T(5,I)=X
- D:'PSOAPF DPR,HD1^PSOARCF4 S PSOAPF=1 ;DISPLAY DEMO INFO
- RXR D READT G:(X="!")!(X="") END G:$P(X,"^",2)'=NM PAR G:X="" END
- RXR2 I $P($G(X),"^",2)'=NM D READT G:($G(X)="!")!($G(X)="") END
- G:(X="!")!(X="")!($P(X,"^",2)'=NM) END S RX(0)=X D READT
- I (X["$$"),$P(X,"$$",1)["1," D NODE1
- I (X["$$"),$P(X,"$$",1)["4," D NODE4
- I (X["$$"),$P(X,"$$",1)["5," D NODE5
- S RX(2)=X D READT S RX(3)=X D READT
- I (X["$$"),$P(X,"$$",1)["A," D NODEA
- I (X["$$"),$P(X,"$$",1)["L," D NODEL
- I (X["$$"),$P(X,"$$",1)["P," D NODEP
- I (X["$$"),$P(X,"$$",1)["IB" S RX("IB")=$P(X,"$$",2) D READT
- I (X["$$"),$P(X,"$$",1)["C," S RX("C")=$P(X,"$$",2) D READT
- I (X["$$"),$P(X,"$$",1)["D," S RX("D")=$P(X,"$$",2) D READT
- I (X["$$"),$P(X,"$$",1)["S," S RX("S")=$P(X,"$$",2) D READT
- RXR1 U PSOAP D ^PSOARCR2 D PAGE U PSOAT G RXR2
- DPR U PSOAP W !!,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),","
- K T Q
- PAGE Q:$Y'>(PSOACPL-22)
- D HD1^PSOARCF4 Q
- PSOAT ;CHECK FOR EOF
- U PSOAT S:$$STATUS^%ZISH PSORWND=$$REWIND^%ZIS(PSOAIO,PSOAIOT,PSOAPAR) I $G(PSORWND)=0 U IO(0) W !!,"HFS file failed to rewind" G END
- U PSOAT
- Q
- NODE1 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["1,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- Q
- NODE4 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["4,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- Q
- NODE5 S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["5,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- Q
- NODEA S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- F D READT Q:($P(X,"^")'["$$")!($P(X,"$$",1)'["A,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- Q
- NODEL S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- F D READT Q:($P(X,"^")'["$")!($P(X,"$$",1)'["L,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- Q
- NODEP S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- F D READT Q:($P(X,"^")'["$$")!($P(X,"$$",1)'["P,") S XX=$P(X,"$$",1) S RX(XX)=$P(X,"$$",2)
- Q
- READT D PSOAT R X:DTIME G:'$T END G END:X="" Q
- PSOARCF2 ;BHAM ISC/LGH,LC - RX RETRIEVE ; 07/07/92
- +1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
- +2 USE PSOAT
- SET PSORWND=$$REWIND^%ZIS(PSOAIO,PSOAIOT,PSOAPAR)
- IF $GET(PSORWND)=0
- USE IO(0)
- WRITE !!,"HFS file failed to rewind"
- GOTO END
- +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 ;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
- +1 ;K PSOACPM,PSOACPL,PSOACPF,NM,T,PSOAP,PSOAT,^TMP($J,"ZRX"),A,DG,GD,I,PSOACDS,PSOAEOT,Y,RX,%MT,D,PSOAPF,PSOATNM,X,XX
- +2 KILL ^TMP($JOB,"ZRX"),NM,SS,X,XX,XNM,XSS,T,TZ,A,DG,GD,I,Y,RX,D
- +3 QUIT
- PR ;PATIENT READ
- +1 SET T(1)=X
- DO READT
- 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>""
- FOR I=1:1:D
- DO READT
- SET T(2,I)=X
- +3 IF A>""
- FOR I=1:1:A
- DO READT
- SET T(3,I)=X
- +4 IF DG>""
- FOR I=1:1:DG
- DO READT
- SET T(4,I)=X
- +5 IF GD>""
- FOR I=1:1:GD
- DO READT
- SET T(5,I)=X
- +6 ;DISPLAY DEMO INFO
- IF 'PSOAPF
- DO DPR
- DO HD1^PSOARCF4
- SET PSOAPF=1
- RXR DO READT
- IF (X="!")!(X="")
- GOTO END
- IF $PIECE(X,"^",2)'=NM
- GOTO PAR
- IF X=""
- GOTO END
- RXR2 IF $PIECE($GET(X),"^",2)'=NM
- DO READT
- IF ($GET(X)="!")!($GET(X)="")
- GOTO END
- +1 IF (X="!")!(X="")!($PIECE(X,"^",2)'=NM)
- GOTO END
- SET RX(0)=X
- DO READT
- +2 IF (X["$$")
- IF $PIECE(X,"$$",1)["1,"
- DO NODE1
- +3 IF (X["$$")
- IF $PIECE(X,"$$",1)["4,"
- DO NODE4
- +4 IF (X["$$")
- IF $PIECE(X,"$$",1)["5,"
- DO NODE5
- +5 SET RX(2)=X
- DO READT
- SET RX(3)=X
- DO READT
- +6 IF (X["$$")
- IF $PIECE(X,"$$",1)["A,"
- DO NODEA
- +7 IF (X["$$")
- IF $PIECE(X,"$$",1)["L,"
- DO NODEL
- +8 IF (X["$$")
- IF $PIECE(X,"$$",1)["P,"
- DO NODEP
- +9 IF (X["$$")
- IF $PIECE(X,"$$",1)["IB"
- SET RX("IB")=$PIECE(X,"$$",2)
- DO READT
- +10 IF (X["$$")
- IF $PIECE(X,"$$",1)["C,"
- SET RX("C")=$PIECE(X,"$$",2)
- DO READT
- +11 IF (X["$$")
- IF $PIECE(X,"$$",1)["D,"
- SET RX("D")=$PIECE(X,"$$",2)
- DO READT
- +12 IF (X["$$")
- IF $PIECE(X,"$$",1)["S,"
- SET RX("S")=$PIECE(X,"$$",2)
- DO READT
- RXR1 USE PSOAP
- DO ^PSOARCR2
- DO PAGE
- USE PSOAT
- GOTO RXR2
- DPR USE PSOAP
- WRITE !!,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 KILL T
- QUIT
- PAGE IF $Y'>(PSOACPL-22)
- QUIT
- +1 DO HD1^PSOARCF4
- QUIT
- PSOAT ;CHECK FOR EOF
- +1 USE PSOAT
- IF $$STATUS^%ZISH
- SET PSORWND=$$REWIND^%ZIS(PSOAIO,PSOAIOT,PSOAPAR)
- IF $GET(PSORWND)=0
- USE IO(0)
- WRITE !!,"HFS file failed to rewind"
- GOTO END
- +2 USE PSOAT
- +3 QUIT
- NODE1 SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +1 FOR
- DO READT
- IF ($PIECE(X,"^")'["$")!($PIECE(X,"$$",1)'["1,")
- QUIT
- SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +2 QUIT
- NODE4 SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +1 FOR
- DO READT
- IF ($PIECE(X,"^")'["$")!($PIECE(X,"$$",1)'["4,")
- QUIT
- SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +2 QUIT
- NODE5 SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +1 FOR
- DO READT
- IF ($PIECE(X,"^")'["$")!($PIECE(X,"$$",1)'["5,")
- QUIT
- SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +2 QUIT
- NODEA SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +1 FOR
- DO READT
- IF ($PIECE(X,"^")'["$$")!($PIECE(X,"$$",1)'["A,")
- QUIT
- SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +2 QUIT
- NODEL SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +1 FOR
- DO READT
- IF ($PIECE(X,"^")'["$")!($PIECE(X,"$$",1)'["L,")
- QUIT
- SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +2 QUIT
- NODEP SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +1 FOR
- DO READT
- IF ($PIECE(X,"^")'["$$")!($PIECE(X,"$$",1)'["P,")
- QUIT
- SET XX=$PIECE(X,"$$",1)
- SET RX(XX)=$PIECE(X,"$$",2)
- +2 QUIT
- READT DO PSOAT
- READ X:DTIME
- IF '$TEST
- GOTO END
- IF X=""
- GOTO END
- QUIT
