- PSODSPL ;IHS/DSD/JCM - DISPLAY RX PROFILE TO SCREEN ;03/07/93 18:11
- ;;7.0;OUTPATIENT PHARMACY;**132,251,375,490,441**;DEC 1997;Build 208
- ; Input Variables: PSOSD(,
- ; Optional Input Variables: PSOOPT
- ;
- ; display profiles needs PSOOPT=3 from new PSOOPT=4 from refill,
- ; or PSOOPT=0 from anywhere
- ; PSOOPT=-1 to get numbered list but no refill/renew message
- ;---------------------------------------------------------------
- START ;
- I '$G(PSOSD) W $C(7),!!,"This patient has no prescriptions",!! S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR K DIR G END
- D EOJ,SHOW
- END D EOJ
- Q
- ;-----------------------------------------------------------------
- SHOW ;
- N PSODRUG,PSOSTA,PSODATA,PSOQFLG,PSOCT,PSOCNT,PSODLQT
- S PSOPENFL=0
- S (PSOSTA,PSODRUG)="",(PSOCNT,PSOQFLG)=0
- D HD^PSODDPR2() Q:$G(PSODLQT)
- D HD F PSCNT=0:0 S PSOSTA=$O(PSOSD(PSOSTA)) Q:PSOSTA=""!($G(PSOQFLG)) D STA F PSOCT=0:0 S PSODRUG=$O(PSOSD(PSOSTA,PSODRUG)) Q:PSODRUG="" Q:PSOCNT>1000!PSOQFLG D
- .S PSODATA=PSOSD(PSOSTA,PSODRUG),PSOCNT=PSOCNT+1 I PSOSTA="PENDING" D PEN Q
- .I PSOSTA="ZNONVA" D Q
- ..W !," "_$P(PSODRUG,"^")_" "_$P(PSODATA,"^",6)_" "_$P(PSODATA,"^",8)
- ..I ($L(" "_$P(PSODRUG,"^")_" "_$P(PSODATA,"^",6)_" "_$P(PSODATA,"^",8))+20)>70 W !
- ..W ?50,"Date Documented: "_$E($P(PSODATA,"^",9),4,5)_"/"_$E($P(PSODATA,"^",9),6,7)_"/"_$E($P(PSODATA,"^",9),2,3)
- .S:'$D(^PSRX(+PSODATA,0)) PSOCNT=PSOCNT-1 D:$D(^(0)) DISPL Q:$G(PSODLQT)
- W !
- I $G(INPAT),'$G(PSODLQT) K DIR S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR K DIR G SHOWX ;*490
- D HD^PSODDPR2() ;*490
- SHOWX K DIRUT,DTOUT,DUOUT,DIROUT S PSOCNT=PSOCNT-1 ;K PSODRUG
- Q
- ;
- HD ;
- Q:$G(PSODLQT)
- I $Y+5>IOSL S (DX,DY)=0 X ^%ZOSF("XY") K DX,DY
- Q:$G(PSOPENFL) K LINE
- W !!,?61,"ISSUE",?68,"LAST",?73,"REF DAY",!,?4,"RX #",?17,"DRUG",?54,"QTY",?58,"ST",?62,"DATE",?68,"FILL",?73,"REM",?77,"SUP" S $P(LINE,"-",80)="-" W !,LINE K LINE
- Q
- DISPL W ! I $G(PSOOPT) W $J(PSOCNT,2)
- S PSODQLZ=$L($P(PSODRUG,"^"))+$L($P(^PSRX(+PSODATA,0),"^",7))
- W ?3,$P(^PSRX(+PSODATA,0),"^")_$S($G(^PSRX(+PSODATA,"IB")):"$",1:"")
- S PSOQTLZ=57-$L($P(^PSRX(+PSODATA,0),"^",7)) I PSODQLZ<39 W ?17,$P(PSODRUG,"^"),?PSOQTLZ,$P(^PSRX(+PSODATA,0),"^",7)
- E W ?17,$P(PSODRUG,"^")
- N PSOCMOP,STATL
- I $D(^PSDRUG("AQ",$P(^PSRX(+PSODATA,0),"^",6))) S PSOCMOP=">"
- N X S X="PSXOPUTL" X ^%ZOSF("TEST") K X I $T D
- .N DA S DA=+PSODATA D ^PSXOPUTL K DA
- .I $G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2) S PSOCMOP="T"
- .K PSXZ
- S STA="A^N^R^H^N^S^^^^^^E^DC^^DP^DE^HP^P^"
- S STATL=$P(STA,"^",$P(PSODATA,"^",2)+1) D
- .I $G(^PSRX(+PSODATA,"DDSTA"))]"" S STATL="DD" Q
- .S STATL=$S($P($G(^PSRX(+PSODATA,7)),"^")=1:"DA",$P($G(^PSRX(+PSODATA,7)),"^")=2:"DF",1:STATL)
- I STATL="A",$P(PSODATA,"^",2)=0,$G(^PSRX($P(PSODATA,"^"),"PARK")) S STATL="AP" ;441 PAPI
- W ?58,STATL W $G(PSOCMOP) K STA
- S PSOID=$P(^PSRX(+PSODATA,0),"^",13),PSOLF=+^(3) W ?61,$E(PSOID,4,5)_"-"_$E(PSOID,6,7)
- F PSOX=0:0 S PSOX=$O(^PSRX(+PSODATA,1,PSOX)) Q:'PSOX I +^PSRX(+PSODATA,1,PSOX,0)=PSOLF,$P(^PSRX(+PSODATA,1,PSOX,0),"^",16) S PSOLF=PSOLF_"^R"
- I '$O(^PSRX(+PSODATA,1,0)),$P(^PSRX(+PSODATA,2),"^",15) S PSOLF=PSOLF_"^R"
- W ?67,$S(+PSOLF:$E(PSOLF,4,5)_"-"_$E(PSOLF,6,7),1:" - "),$P(PSOLF,"^",2)
- W ?74,$J($P(PSODATA,"^",6),2)
- W ?78,$J($P(PSODATA,"^",8),2)
- I PSODQLZ>38 S PSOQTLZ=PSOQTLZ-5 W !?PSOQTLZ,"Qty: ",$P(^PSRX(+PSODATA,0),"^",7)
- K PSODQLZ,PSOQTLZ,PSODATA,PSOID,PSOLF,PSOX
- ;
- EOF I $Y+5>IOSL,$O(PSOSD(PSOSTA,PSODRUG))]"" K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT)!$G(DTOUT)!($G(DIRUT)) PSOHI=PSOCNT,PSODLQT=1,PSOQFLG=1 K DIRUT,DTOUT,DUOUT,DIROUT D:'PSOQFLG HD,STA
- ;
- Q
- STA ;
- Q:$G(PSOQFLG)!($G(PSODLQT))
- I PSOSTA="ZNONVA" S ZSTA=PSOSTA,PSOSTA="Non-VA MEDS (Not dispensed by VA)"
- S STR=($L(PSOSTA)+IOM/2)-$L(PSOSTA),STP=IOM-(STR+$L(PSOSTA)) W ! F I=1:1:STR W "-"
- W PSOSTA F I=1:1:STP W "-"
- I $G(ZSTA)]"" W "-" S PSOSTA=ZSTA K ZSTA
- Q
- EOJ ;
- K PSOHI,PSOQFLG,PSODATA,PSOID,PSOLF,PSOCNT,PSOLO1,PSOPENFL
- Q
- PEN ;
- N PSCMOPR S PSCMOPR=0 I $P($G(PSODATA),"^",11),$D(^PSDRUG("AQ",$P(PSODATA,"^",11))) S PSCMOPR=1
- W ! I $G(PSOOPT) W $J(PSOCNT,2)
- S PSOPENFL=1
- S PSODQLZ=$L($P(PSODRUG,"^")),PSOQTLZ=$L($P(PSODATA,"^",8))
- W ?3,$P(PSODRUG,"^") I +$G(PSODQLZ)>37 W !
- ;W ?49,"ISDT: ",$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_" QTY: "_$S(PSOQTLZ=1:" ",PSOQTLZ=2:" ",1:"")_$P(PSODATA,"^",8)_" REF: "_$J($P(PSODATA,"^",6),2)
- W ?42,"QTY: ",$P(PSODATA,"^",8),?59,"ISDT: ",$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_$S($G(PSCMOPR):"> ",1:" ")_"REF: "_$J($P(PSODATA,"^",6),2)
- K PSODATA,PSOID,PSOLF,PSODQLZ,PSOQTLZ D EOF
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODSPL 4706 printed Jan 18, 2025@03:28:34 Page 2
- PSODSPL ;IHS/DSD/JCM - DISPLAY RX PROFILE TO SCREEN ;03/07/93 18:11
- +1 ;;7.0;OUTPATIENT PHARMACY;**132,251,375,490,441**;DEC 1997;Build 208
- +2 ; Input Variables: PSOSD(,
- +3 ; Optional Input Variables: PSOOPT
- +4 ;
- +5 ; display profiles needs PSOOPT=3 from new PSOOPT=4 from refill,
- +6 ; or PSOOPT=0 from anywhere
- +7 ; PSOOPT=-1 to get numbered list but no refill/renew message
- +8 ;---------------------------------------------------------------
- START ;
- +1 IF '$GET(PSOSD)
- WRITE $CHAR(7),!!,"This patient has no prescriptions",!!
- SET DIR(0)="EA"
- SET DIR("A")="Press RETURN to continue: "
- DO ^DIR
- KILL DIR
- GOTO END
- +2 DO EOJ
- DO SHOW
- END DO EOJ
- +1 QUIT
- +2 ;-----------------------------------------------------------------
- SHOW ;
- +1 NEW PSODRUG,PSOSTA,PSODATA,PSOQFLG,PSOCT,PSOCNT,PSODLQT
- +2 SET PSOPENFL=0
- +3 SET (PSOSTA,PSODRUG)=""
- SET (PSOCNT,PSOQFLG)=0
- +4 DO HD^PSODDPR2()
- if $GET(PSODLQT)
- QUIT
- +5 DO HD
- FOR PSCNT=0:0
- SET PSOSTA=$ORDER(PSOSD(PSOSTA))
- if PSOSTA=""!($GET(PSOQFLG))
- QUIT
- DO STA
- FOR PSOCT=0:0
- SET PSODRUG=$ORDER(PSOSD(PSOSTA,PSODRUG))
- if PSODRUG=""
- QUIT
- if PSOCNT>1000!PSOQFLG
- QUIT
- Begin DoDot:1
- +6 SET PSODATA=PSOSD(PSOSTA,PSODRUG)
- SET PSOCNT=PSOCNT+1
- IF PSOSTA="PENDING"
- DO PEN
- QUIT
- +7 IF PSOSTA="ZNONVA"
- Begin DoDot:2
- +8 WRITE !," "_$PIECE(PSODRUG,"^")_" "_$PIECE(PSODATA,"^",6)_" "_$PIECE(PSODATA,"^",8)
- +9 IF ($LENGTH(" "_$PIECE(PSODRUG,"^")_" "_$PIECE(PSODATA,"^",6)_" "_$PIECE(PSODATA,"^",8))+20)>70
- WRITE !
- +10 WRITE ?50,"Date Documented: "_$EXTRACT($PIECE(PSODATA,"^",9),4,5)_"/"_$EXTRACT($PIECE(PSODATA,"^",9),6,7)_"/"_$EXTRACT($PIECE(PSODATA,"^",9),2,3)
- End DoDot:2
- QUIT
- +11 if '$DATA(^PSRX(+PSODATA,0))
- SET PSOCNT=PSOCNT-1
- if $DATA(^(0))
- DO DISPL
- if $GET(PSODLQT)
- QUIT
- End DoDot:1
- +12 WRITE !
- +13 ;*490
- IF $GET(INPAT)
- IF '$GET(PSODLQT)
- KILL DIR
- SET DIR(0)="EA"
- SET DIR("A")="Press RETURN to continue: "
- DO ^DIR
- KILL DIR
- GOTO SHOWX
- +14 ;*490
- DO HD^PSODDPR2()
- SHOWX ;K PSODRUG
- KILL DIRUT,DTOUT,DUOUT,DIROUT
- SET PSOCNT=PSOCNT-1
- +1 QUIT
- +2 ;
- HD ;
- +1 if $GET(PSODLQT)
- QUIT
- +2 IF $Y+5>IOSL
- SET (DX,DY)=0
- XECUTE ^%ZOSF("XY")
- KILL DX,DY
- +3 if $GET(PSOPENFL)
- QUIT
- KILL LINE
- +4 WRITE !!,?61,"ISSUE",?68,"LAST",?73,"REF DAY",!,?4,"RX #",?17,"DRUG",?54,"QTY",?58,"ST",?62,"DATE",?68,"FILL",?73,"REM",?77,"SUP"
- SET $PIECE(LINE,"-",80)="-"
- WRITE !,LINE
- KILL LINE
- +5 QUIT
- DISPL WRITE !
- IF $GET(PSOOPT)
- WRITE $JUSTIFY(PSOCNT,2)
- +1 SET PSODQLZ=$LENGTH($PIECE(PSODRUG,"^"))+$LENGTH($PIECE(^PSRX(+PSODATA,0),"^",7))
- +2 WRITE ?3,$PIECE(^PSRX(+PSODATA,0),"^")_$SELECT($GET(^PSRX(+PSODATA,"IB")):"$",1:"")
- +3 SET PSOQTLZ=57-$LENGTH($PIECE(^PSRX(+PSODATA,0),"^",7))
- IF PSODQLZ<39
- WRITE ?17,$PIECE(PSODRUG,"^"),?PSOQTLZ,$PIECE(^PSRX(+PSODATA,0),"^",7)
- +4 IF '$TEST
- WRITE ?17,$PIECE(PSODRUG,"^")
- +5 NEW PSOCMOP,STATL
- +6 IF $DATA(^PSDRUG("AQ",$PIECE(^PSRX(+PSODATA,0),"^",6)))
- SET PSOCMOP=">"
- +7 NEW X
- SET X="PSXOPUTL"
- XECUTE ^%ZOSF("TEST")
- KILL X
- IF $TEST
- Begin DoDot:1
- +8 NEW DA
- SET DA=+PSODATA
- DO ^PSXOPUTL
- KILL DA
- +9 IF $GET(PSXZ(PSXZ("L")))=0!($GET(PSXZ(PSXZ("L")))=2)
- SET PSOCMOP="T"
- +10 KILL PSXZ
- End DoDot:1
- +11 SET STA="A^N^R^H^N^S^^^^^^E^DC^^DP^DE^HP^P^"
- +12 SET STATL=$PIECE(STA,"^",$PIECE(PSODATA,"^",2)+1)
- Begin DoDot:1
- +13 IF $GET(^PSRX(+PSODATA,"DDSTA"))]""
- SET STATL="DD"
- QUIT
- +14 SET STATL=$SELECT($PIECE($GET(^PSRX(+PSODATA,7)),"^")=1:"DA",$PIECE($GET(^PSRX(+PSODATA,7)),"^")=2:"DF",1:STATL)
- End DoDot:1
- +15 ;441 PAPI
- IF STATL="A"
- IF $PIECE(PSODATA,"^",2)=0
- IF $GET(^PSRX($PIECE(PSODATA,"^"),"PARK"))
- SET STATL="AP"
- +16 WRITE ?58,STATL
- WRITE $GET(PSOCMOP)
- KILL STA
- +17 SET PSOID=$PIECE(^PSRX(+PSODATA,0),"^",13)
- SET PSOLF=+^(3)
- WRITE ?61,$EXTRACT(PSOID,4,5)_"-"_$EXTRACT(PSOID,6,7)
- +18 FOR PSOX=0:0
- SET PSOX=$ORDER(^PSRX(+PSODATA,1,PSOX))
- if 'PSOX
- QUIT
- IF +^PSRX(+PSODATA,1,PSOX,0)=PSOLF
- IF $PIECE(^PSRX(+PSODATA,1,PSOX,0),"^",16)
- SET PSOLF=PSOLF_"^R"
- +19 IF '$ORDER(^PSRX(+PSODATA,1,0))
- IF $PIECE(^PSRX(+PSODATA,2),"^",15)
- SET PSOLF=PSOLF_"^R"
- +20 WRITE ?67,$SELECT(+PSOLF:$EXTRACT(PSOLF,4,5)_"-"_$EXTRACT(PSOLF,6,7),1:" - "),$PIECE(PSOLF,"^",2)
- +21 WRITE ?74,$JUSTIFY($PIECE(PSODATA,"^",6),2)
- +22 WRITE ?78,$JUSTIFY($PIECE(PSODATA,"^",8),2)
- +23 IF PSODQLZ>38
- SET PSOQTLZ=PSOQTLZ-5
- WRITE !?PSOQTLZ,"Qty: ",$PIECE(^PSRX(+PSODATA,0),"^",7)
- +24 KILL PSODQLZ,PSOQTLZ,PSODATA,PSOID,PSOLF,PSOX
- +25 ;
- EOF IF $Y+5>IOSL
- IF $ORDER(PSOSD(PSOSTA,PSODRUG))]""
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if $DATA(DUOUT)!$GET(DTOUT)!($GET(DIRUT))
- SET PSOHI=PSOCNT
- SET PSODLQT=1
- SET PSOQFLG=1
- KILL DIRUT,DTOUT,DUOUT,DIROUT
- if 'PSOQFLG
- DO HD
- DO STA
- +1 ;
- +2 QUIT
- STA ;
- +1 if $GET(PSOQFLG)!($GET(PSODLQT))
- QUIT
- +2 IF PSOSTA="ZNONVA"
- SET ZSTA=PSOSTA
- SET PSOSTA="Non-VA MEDS (Not dispensed by VA)"
- +3 SET STR=($LENGTH(PSOSTA)+IOM/2)-$LENGTH(PSOSTA)
- SET STP=IOM-(STR+$LENGTH(PSOSTA))
- WRITE !
- FOR I=1:1:STR
- WRITE "-"
- +4 WRITE PSOSTA
- FOR I=1:1:STP
- WRITE "-"
- +5 IF $GET(ZSTA)]""
- WRITE "-"
- SET PSOSTA=ZSTA
- KILL ZSTA
- +6 QUIT
- EOJ ;
- +1 KILL PSOHI,PSOQFLG,PSODATA,PSOID,PSOLF,PSOCNT,PSOLO1,PSOPENFL
- +2 QUIT
- PEN ;
- +1 NEW PSCMOPR
- SET PSCMOPR=0
- IF $PIECE($GET(PSODATA),"^",11)
- IF $DATA(^PSDRUG("AQ",$PIECE(PSODATA,"^",11)))
- SET PSCMOPR=1
- +2 WRITE !
- IF $GET(PSOOPT)
- WRITE $JUSTIFY(PSOCNT,2)
- +3 SET PSOPENFL=1
- +4 SET PSODQLZ=$LENGTH($PIECE(PSODRUG,"^"))
- SET PSOQTLZ=$LENGTH($PIECE(PSODATA,"^",8))
- +5 WRITE ?3,$PIECE(PSODRUG,"^")
- IF +$GET(PSODQLZ)>37
- WRITE !
- +6 ;W ?49,"ISDT: ",$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_" QTY: "_$S(PSOQTLZ=1:" ",PSOQTLZ=2:" ",1:"")_$P(PSODATA,"^",8)_" REF: "_$J($P(PSODATA,"^",6),2)
- +7 WRITE ?42,"QTY: ",$PIECE(PSODATA,"^",8),?59,"ISDT: ",$SELECT('$PIECE(PSODATA,"^",9):" ",1:$EXTRACT($PIECE(PSODATA,"^",9),4,5)_"-"_$EXTRACT($PIECE(PSODATA,"^",9),6,7))_$SELECT($GET(PSCMOPR):"> ",1:" ")_"REF: "_$JUSTIFY($PIECE(PSODATA,"^",6)
- ,2)
- +8 KILL PSODATA,PSOID,PSOLF,PSODQLZ,PSOQTLZ
- DO EOF
- +9 QUIT