Routine: PSODSPL

PSODSPL ;IHS/DSD/JCM - DISPLAY RX PROFILE TO SCREEN ;16-Jan-2008 23:09;SM

 ;;7.0;OUTPATIENT PHARMACY;**132,1005,1006**;DEC 1997

 ; Input Variables: PSOSD(,

 ; Optional Inupt 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

 ;---------------------------------------------------------------

 ; Modified - IHS/CIA/PLS - 01/06/04 - Added Crow mods

 ;            IHS/MSC/PLS - 10/11/07 - Line STA+9

 ;            IHS/MSC/PLS - 10/16/07 - Line label DISPL

 ;                          01/16/08 - Line SHOW+17

START ;

 I '$G(PSOSD) W $C(7),!!,"This patient has no prescriptions",! G END

 D EOJ,SHOW

END D EOJ

 ;-----------------------------------------------------------------

SHOW ;

 S PSOPENFL=0

 S (PSOSTA,PSODRUG)="",(PSOCNT,PSOQFLG)=0

 ;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

 ;  5/23/2002  dmh commented out the top line and added the next one to

 ;             check for the APSPDSC("QFLG")  that gets set in the

 ;             STA module of this routine

 D HD F PSCNT=0:0 S PSOSTA=$O(PSOSD(PSOSTA)) Q:PSOSTA=""!($G(PSOQFLG))  D STA F PSOCT=0:0 Q:$D(APSPDSC("QFLG"))  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

 I PSOQFLG G SHOWX

 S X="APSQSHOW" X ^%ZOSF("TEST") I $T D EN^APSQSHOW("SHOW",1)  ; IHS/CIA/PLS - 01/12/04 Outside Rxs in VMed

 ;I $D(PSOOPT),(PSOOPT>2) W !!?10,"* indicates prescription is not renewable and/or refillable"

 S X="APSQSHOW" X ^%ZOSF("TEST") I $T W !,?10,"(%) indicates this is a free text drug name not in drug file" ;IHS/OKCAO/POC 12/3/2000

 K DIR S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR S:'$D(DFN) DFN=PSODFN D:'$G(INPAT) GMRA^PSODEM

SHOWX W ! K DIRUT,DTOUT,DUOUT,DIROUT S PSOCNT=PSOCNT-1 K PSODRUG

HD ;

 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

 ;IHS/MSC/PLS - 10/18/07

DISPL W !

 S:PSOSTA="ACTIVE OTHER PHARMACY" PSOCNT=PSOCNT-1

 ;I $G(PSOOPT) W $J(PSOCNT,2)

 I $G(PSOOPT) W:PSOSTA'="ACTIVE OTHER PHARMACY" $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

 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^^DC^DE^H^P^" W ?58,$P(STA,"^",$P(PSODATA,"^",2)+1) W $G(PSOCMOP) K STA

 S PSOID=$P(^PSRX(+PSODATA,0),"^",13),PSOLF=+^(3) W ?61,$E(PSOID,4,5)_"-"_$E(PSOID,6,7)

 ;  dmh added next line to set up array for SUMM. LABELS 2/27/2002

 S APSPZDT(PSOLF,PSOCNT)=+PSODATA  ;IHS/DSD/ 4-28-95 USED BY SUM L.

 S APSPZDT=PSOCNT   ; IHS/CIA/PLS - 01/13/04 - Capture line count

 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) PSOHI=PSOCNT,PSOQFLG=1 K DIRUT,DTOUT,DUOUT,DIROUT D:'PSOQFLG HD,STA

STA ;

 ;  dmh added this check  APSPDSC("ST") may be set from APSPDSC routine

 ;  5/23/2002  dmh added the next 2 lines  to check for it and

 ;  only print sta line if status is same as what was set in APSPDSC

 ;  will also set a flag for loop stop above

 K APSPDSC("QFLG")

 I ($G(APSPDSC("ST"))'=""),(PSOSTA'=APSPDSC("ST")) S APSPDSC("QFLG")="Y" Q

 Q:$G(PSOQFLG)

 ;IHS/MSC/PLS - 10/11/07

 ;I PSOSTA="ZNONVA" S ZSTA=PSOSTA,PSOSTA="Non-VA MEDS (Not dispensed by VA)"

 I PSOSTA="ZNONVA" S ZSTA=PSOSTA,PSOSTA="Outside Medications"

 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

EOJ ;

 K PSOHI,PSOQFLG,PSODRUG,PSODATA,PSOID,PSOLF,PSOCNT,PSOLO1,PSOPENFL

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

PSODSPL   ;IHS/DSD/JCM - DISPLAY RX PROFILE TO SCREEN ;16-Jan-2008 23:09;SM

 +1       ;;7.0;OUTPATIENT PHARMACY;**132,1005,1006**;DEC 1997

 +2       ; Input Variables: PSOSD(,

 +3       ; Optional Inupt 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       ;---------------------------------------------------------------

 +9       ; Modified - IHS/CIA/PLS - 01/06/04 - Added Crow mods

 +10      ;            IHS/MSC/PLS - 10/11/07 - Line STA+9

 +11      ;            IHS/MSC/PLS - 10/16/07 - Line label DISPL

 +12      ;                          01/16/08 - Line SHOW+17

START     ;

 +1        IF '$GET(PSOSD)

               WRITE $CHAR(7),!!,"This patient has no prescriptions",!

               GOTO END

 +2        DO EOJ

           DO SHOW

END        DO EOJ

 +1        QUIT

 +2       ;-----------------------------------------------------------------

SHOW      ;

 +1        SET PSOPENFL=0

 +2        SET (PSOSTA,PSODRUG)=""

           SET (PSOCNT,PSOQFLG)=0

 +3       ;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

 +4       ;

 +5       ;  5/23/2002  dmh commented out the top line and added the next one to

 +6       ;             check for the APSPDSC("QFLG")  that gets set in the

 +7       ;             STA module of this routine

 +8       ;

 +9        DO HD

           FOR PSCNT=0:0

               SET PSOSTA=$ORDER(PSOSD(PSOSTA))

               IF PSOSTA=""!($GET(PSOQFLG))

                   QUIT

               DO STA

               FOR PSOCT=0:0

                   IF $DATA(APSPDSC("QFLG"))

                       QUIT

                   SET PSODRUG=$ORDER(PSOSD(PSOSTA,PSODRUG))

                   IF PSODRUG=""

                       QUIT

                   IF PSOCNT>1000!PSOQFLG

                       QUIT

                   Begin DoDot:1

 +10                   SET PSODATA=PSOSD(PSOSTA,PSODRUG)

                       SET PSOCNT=PSOCNT+1

                       IF PSOSTA="PENDING"

                           DO PEN

                           QUIT

 +11                   IF PSOSTA="ZNONVA"

                           Begin DoDot:2

 +12                           WRITE !,"  "_$PIECE(PSODRUG,"^")_" "_$PIECE(PSODATA,"^",6)_" "_$PIECE(PSODATA,"^",8)

 +13                           IF ($LENGTH("  "_$PIECE(PSODRUG,"^")_" "_$PIECE(PSODATA,"^",6)_" "_$PIECE(PSODATA,"^",8))+20)>70

                                   WRITE !

 +14                           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

 +15                   IF '$DATA(^PSRX(+PSODATA,0))

                           SET PSOCNT=PSOCNT-1

                       IF $DATA(^(0))

                           DO DISPL

                   End DoDot:1

 +16       IF PSOQFLG

               GOTO SHOWX

 +17      ; IHS/CIA/PLS - 01/12/04 Outside Rxs in VMed

           SET X="APSQSHOW"

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               DO EN^APSQSHOW("SHOW",1)

 +18      ;I $D(PSOOPT),(PSOOPT>2) W !!?10,"* indicates prescription is not renewable and/or refillable"

 +19      ;IHS/OKCAO/POC 12/3/2000

           SET X="APSQSHOW"

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               WRITE !,?10,"(%) indicates this is a free text drug name not in drug file"

 +20       KILL DIR

           SET DIR(0)="EA"

           SET DIR("A")="Press RETURN to continue: "

           DO ^DIR

           IF '$DATA(DFN)

               SET DFN=PSODFN

           IF '$GET(INPAT)

               DO GMRA^PSODEM

SHOWX      WRITE !

           KILL DIRUT,DTOUT,DUOUT,DIROUT

           SET PSOCNT=PSOCNT-1

           KILL PSODRUG

 +1        QUIT

 +2       ;

HD        ;

 +1        IF $Y+5>IOSL

               SET (DX,DY)=0

               XECUTE ^%ZOSF("XY")

               KILL DX,DY

 +2        IF $GET(PSOPENFL)

               QUIT

           KILL LINE

 +3        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

 +4        QUIT

 +5       ;IHS/MSC/PLS - 10/18/07

DISPL      WRITE !

 +1        IF PSOSTA="ACTIVE OTHER PHARMACY"

               SET PSOCNT=PSOCNT-1

 +2       ;I $G(PSOOPT) W $J(PSOCNT,2)

 +3        IF $GET(PSOOPT)

               IF PSOSTA'="ACTIVE OTHER PHARMACY"

                   WRITE $JUSTIFY(PSOCNT,2)

 +4        SET PSODQLZ=$LENGTH($PIECE(PSODRUG,"^"))+$LENGTH($PIECE(^PSRX(+PSODATA,0),"^",7))

 +5        WRITE ?3,$PIECE(^PSRX(+PSODATA,0),"^")_$SELECT($GET(^PSRX(+PSODATA,"IB")):"$",1:"")

 +6        SET PSOQTLZ=57-$LENGTH($PIECE(^PSRX(+PSODATA,0),"^",7))

           IF PSODQLZ<39

               WRITE ?17,$PIECE(PSODRUG,"^"),?PSOQTLZ,$PIECE(^PSRX(+PSODATA,0),"^",7)

 +7       IF '$TEST

               WRITE ?17,$PIECE(PSODRUG,"^")

 +8        NEW PSOCMOP

 +9        IF $DATA(^PSDRUG("AQ",$PIECE(^PSRX(+PSODATA,0),"^",6)))

               SET PSOCMOP=">"

 +10       NEW X

           SET X="PSXOPUTL"

           XECUTE ^%ZOSF("TEST")

           KILL X

           IF $TEST

               Begin DoDot:1

 +11               NEW DA

                   SET DA=+PSODATA

                   DO ^PSXOPUTL

                   KILL DA

 +12               IF $GET(PSXZ(PSXZ("L")))=0!($GET(PSXZ(PSXZ("L")))=2)

                       SET PSOCMOP="T"

 +13               KILL PSXZ

               End DoDot:1

 +14       SET STA="A^N^R^H^N^S^^^^^^E^DC^^DC^DE^H^P^"

           WRITE ?58,$PIECE(STA,"^",$PIECE(PSODATA,"^",2)+1)

           WRITE $GET(PSOCMOP)

           KILL STA

 +15       SET PSOID=$PIECE(^PSRX(+PSODATA,0),"^",13)

           SET PSOLF=+^(3)

           WRITE ?61,$EXTRACT(PSOID,4,5)_"-"_$EXTRACT(PSOID,6,7)

 +16      ;

 +17      ;  dmh added next line to set up array for SUMM. LABELS 2/27/2002

 +18      ;IHS/DSD/ 4-28-95 USED BY SUM L.

           SET APSPZDT(PSOLF,PSOCNT)=+PSODATA

 +19      ; IHS/CIA/PLS - 01/13/04 - Capture line count

           SET APSPZDT=PSOCNT

 +20      ;

 +21      ;

 +22       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"

 +23       IF '$ORDER(^PSRX(+PSODATA,1,0))

               IF $PIECE(^PSRX(+PSODATA,2),"^",15)

                   SET PSOLF=PSOLF_"^R"

 +24       WRITE ?67,$SELECT(+PSOLF:$EXTRACT(PSOLF,4,5)_"-"_$EXTRACT(PSOLF,6,7),1:"  -  "),$PIECE(PSOLF,"^",2)

 +25       WRITE ?74,$JUSTIFY($PIECE(PSODATA,"^",6),2)

 +26       WRITE ?78,$JUSTIFY($PIECE(PSODATA,"^",8),2)

 +27       IF PSODQLZ>38

               SET PSOQTLZ=PSOQTLZ-5

               WRITE !?PSOQTLZ,"Qty: ",$PIECE(^PSRX(+PSODATA,0),"^",7)

 +28       KILL PSODQLZ,PSOQTLZ,PSODATA,PSOID,PSOLF,PSOX

 +29      ;

EOF        IF $Y+5>IOSL

               IF $ORDER(PSOSD(PSOSTA,PSODRUG))]""

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET PSOHI=PSOCNT

                       SET PSOQFLG=1

                   KILL DIRUT,DTOUT,DUOUT,DIROUT

                   IF 'PSOQFLG

                       DO HD

                       DO STA

 +1       ;

 +2        QUIT

STA       ;

 +1       ;  dmh added this check  APSPDSC("ST") may be set from APSPDSC routine

 +2       ;  5/23/2002  dmh added the next 2 lines  to check for it and

 +3       ;  only print sta line if status is same as what was set in APSPDSC

 +4       ;  will also set a flag for loop stop above

 +5       ;

 +6        KILL APSPDSC("QFLG")

 +7        IF ($GET(APSPDSC("ST"))'="")

               IF (PSOSTA'=APSPDSC("ST"))

                   SET APSPDSC("QFLG")="Y"

                   QUIT

 +8        IF $GET(PSOQFLG)

               QUIT

 +9       ;IHS/MSC/PLS - 10/11/07

 +10      ;I PSOSTA="ZNONVA" S ZSTA=PSOSTA,PSOSTA="Non-VA MEDS (Not dispensed by VA)"

 +11       IF PSOSTA="ZNONVA"

               SET ZSTA=PSOSTA

               SET PSOSTA="Outside Medications"

 +12       SET STR=($LENGTH(PSOSTA)+IOM/2)-$LENGTH(PSOSTA)

           SET STP=IOM-(STR+$LENGTH(PSOSTA))

           WRITE !

           FOR I=1:1:STR

               WRITE "-"

 +13       WRITE PSOSTA

           FOR I=1:1:STP

               WRITE "-"

 +14       IF $GET(ZSTA)]""

               WRITE "-"

               SET PSOSTA=ZSTA

               KILL ZSTA

 +15       QUIT

EOJ       ;

 +1        KILL PSOHI,PSOQFLG,PSODRUG,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

PSODSPL.m