PSIVORV2.m

PSIVORV2 ;BIR/MLM-VIEW AN ORDER (PHARMACY) ;20 Jul 98 / 2:22 PM

 ;;5.0;INPATIENT MEDICATIONS;**15,81,267**;16 DEC 97;Build 158

 ;

 Q

 ;***

 ;V5.0 will be using ^PSJLIFN instead. Other sub-modules in this routine

 ;are being used by IPF...

 ;***

EN ; Display order with numbers.

 D EN^PSJLIORD(DFN,ON) Q

 N PSIVNUM S PSIVNUM=1

 ;

ENNONUM(DFN,PSJORD) ; Display order with no numbers.

 S UL80="",$P(UL80,"=",80)=""

 W:'$G(PSJPRF)&($Y) @IOF W !!,"Patient: ",VADM(1)," (",$P(VADM(2),U,2),")",?52,"Wt (kg): ",PSJPWT," ",PSJPWTD

 W !?3,"Ward: ",$S(VAIN(4):$P(VAIN(4),U,2),1:"OUTPATIENT"),?52,"Ht (cm): ",PSJPHT," ",PSJPWTD

 W !,?1,"Status: ",$$CODES^PSIVUTL(P(17),$S(P("PON")'["V":53.1,1:55.01),$S(P("PON")'["V":28,1:100)) W:P("PON")["V" ?47,"Order number: ",+P("PON") W !,UL80,!

 ;

ENPRO ; Profile view.

 N PSIVAC,Y,PSGEBN,PSGLI,PSJSTAR,PSIV531

 S (PSGEBN,PSGLI)=""

 S PSIVAC="C",P("PON")=ON

 S PSIVUP=+$$GTPCI^PSIVUTL

 S P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I")

 NEW PSJL

 N PSIVNUM S PSIVNUM=1

 I P("OT")="I" D

 . K ^PS(53.45,PSJSYSP,6)

 . S PSJSTAR="(1)^(4)^(5)^(6)^(7)^(9)^(10)"

 . D ^PSJLIVMD K ^PS(53.45,PSJSYSP,6)

 I P("OT")'="I" D

 . K ^PS(53.45,PSJSYSP,6)

 . S PSJSTAR="(1)^(2)^(3)^(4)^(5)^(6)^(7)^(9)"

 . D ^PSJLIVFD K ^PS(53.45,PSJSYSP,6)

 NEW PSIVX

 F PSIVX=0:0 S PSIVX=$O(^TMP("PSJI",$J,PSIVX)) Q:'PSIVX  W !,^(PSIVX,0)

 K ^TMP("PSJI",$J)

 Q

LONG(Y) ; Display long fields.

 F X=1:1:$L(Y," ") D:$X+$L($P(Y," ",X))>$S(LN<11:42,1:80) RC W ?5,$P(Y," ",X)," "

 Q ""

WTPC ; Write provider comments.

 W ?3,Y,!

 ;

PAUSE ;Hold display if end screen, do FF if eop.

 I $E(IOST)="C",($Y#IOSL)>20 N DIR,X,Y S DIR(0)="E" D ^DIR Q:$D(DUOUT)!$D(DTOUT)  W !

 Q

 ;

RC ; Print field by line number

 N X,Y S LN=LN+1 D:LN<11 @LN W !

 Q

 ;

1 ; Type

 W ?56,"Type: " S X=$$CODES^PSIVUTL(P(4),53.1,53) W $S($E(X)="C":"CHEMO",1:X),$S(P(23)'="":" ("_P(23)_")",1:""),$S(P(5)=1:" (I)",P(5)=0:"(C)",1:"")

 Q

 ;

2 ;Syringe Size

 W:P("SYRS")]"" ?51,"Syr. Size: ",$E(P("SYRS"),1,13) W:$L(P("SYRS"))>13 "..."

 Q

 ;

3 ; IV Room

 W ?53,"IV Room: ",$P(P("IVRM"),U,2)

 Q

 ;

4 ; Start Date

 S X="" I $D(PSIVNUM) S:P("DTYP") X=$S(P(17)="P"!(PSIVAC="PN"):" ",1:"*")_$S(P("DTYP")=1:"(12)",$E(P("OT"))="I":"(10)",1:"(8)")

 W ?48-$L(X),X,?50,"Start Date: ",$$WDTE^PSIVUTL(P(2))

 Q

 ;

5 ; Stop Date

 S X="" I $D(PSIVNUM) S:P("DTYP") X=$S(P(17)="P"!(PSIVAC="PN"):" ",1:"*")_$S(P("DTYP")=1:"(13)",$E(P("OT"))="I":"(11)",1:"(9)")

 W ?48-$L(X),X,?51,"Stop Date: ",$$WDTE^PSIVUTL(P(3))

 Q

 ;

6 ; Log-in Date

 W ?50,"Login Date: ",$$WDTE^PSIVUTL(P("LOG"))

 Q

 ;

7 ; Last fill date.

 S Y=$$WDTE^PSIVUTL(P("LF")) W ?51,"Last Fill: ",$S(Y="******":"** Not printed **",1:Y)

 Q

 ;

8 ;Last fill qty.

 W ?52,"Quantity: ",+P("LFA")

 Q

 ;

9 ; Entry Code

 W ?50,"Entry Code: ",$S($P(P("CLRK"),U,2)]"":$E($P(P("CLRK"),U,2),1,18),1:"*** Undefined")

 Q

 ;

10 ; Provider

 S X="" I $D(PSIVNUM),P("DTYP") S X=$S(PSIVAC="PN":" ",1:"*")_$S(P("DTYP")=1:"(14)",$E(P("OT"))="I":"(12)",1:"(10)") ;I P(17)="P",(+P("CLRK")=+P(6)) S X=""

 W ?48-$L(X),X,?52,"Provider: ",$S($P(P(6),U,2)]"":$E($P(P(6),U,2),1,18),1:"*** Undefined")

 Q

ENNH(ON) ;

 I ON'["V" D GT531^PSIVORFA(DFN,ON) S:P(4)="" P(4)="P",(P(2),P(3))="" N PSIV531 S PSIV531=1

 I ON["V" D GT55^PSIVORFB

 N UL S UL="",$P(UL,"-",70)="" W !!,?5,UL,!,?5,"Patient: ",PSGP(0),?54,"Status: ",$S(P(17)="DE":"DC (EDIT)",1:$$CODES^PSIVUTL(P(17),$S(ON'["V":53.1,1:55.01),$S(ON'["V":28,1:100))),!

 D ENPRO

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSIVORV2   3490     printed  Feb 18, 2025@23:31:11                                                                                                                                                                                                    Page 2

PSIVORV2  ;BIR/MLM-VIEW AN ORDER (PHARMACY) ;20 Jul 98 / 2:22 PM

 +1       ;;5.0;INPATIENT MEDICATIONS;**15,81,267**;16 DEC 97;Build 158

 +2       ;

 +3        QUIT 

 +4       ;***

 +5       ;V5.0 will be using ^PSJLIFN instead. Other sub-modules in this routine

 +6       ;are being used by IPF...

 +7       ;***

EN        ; Display order with numbers.

 +1        DO EN^PSJLIORD(DFN,ON)

           QUIT 

 +2        NEW PSIVNUM

           SET PSIVNUM=1

 +3       ;

ENNONUM(DFN,PSJORD) ; Display order with no numbers.

 +1        SET UL80=""

           SET $PIECE(UL80,"=",80)=""

 +2        if '$GET(PSJPRF)&($Y)

               WRITE @IOF

           WRITE !!,"Patient: ",VADM(1)," (",$PIECE(VADM(2),U,2),")",?52,"Wt (kg): ",PSJPWT," ",PSJPWTD

 +3        WRITE !?3,"Ward: ",$SELECT(VAIN(4):$PIECE(VAIN(4),U,2),1:"OUTPATIENT"),?52,"Ht (cm): ",PSJPHT," ",PSJPWTD

 +4        WRITE !,?1,"Status: ",$$CODES^PSIVUTL(P(17),$SELECT(P("PON")'["V":53.1,1:55.01),$SELECT(P("PON")'["V":28,1:100))

           if P("PON")["V"

               WRITE ?47,"Order number: ",+P("PON")

           WRITE !,UL80,!

 +5       ;

ENPRO     ; Profile view.

 +1        NEW PSIVAC,Y,PSGEBN,PSGLI,PSJSTAR,PSIV531

 +2        SET (PSGEBN,PSGLI)=""

 +3        SET PSIVAC="C"

           SET P("PON")=ON

 +4        SET PSIVUP=+$$GTPCI^PSIVUTL

 +5        SET P("OT")=$SELECT(P(4)="A":"F",P(4)="H":"H",1:"I")

 +6        NEW PSJL

 +7        NEW PSIVNUM

           SET PSIVNUM=1

 +8        IF P("OT")="I"

               Begin DoDot:1

 +9                KILL ^PS(53.45,PSJSYSP,6)

 +10               SET PSJSTAR="(1)^(4)^(5)^(6)^(7)^(9)^(10)"

 +11               DO ^PSJLIVMD

                   KILL ^PS(53.45,PSJSYSP,6)

               End DoDot:1

 +12       IF P("OT")'="I"

               Begin DoDot:1

 +13               KILL ^PS(53.45,PSJSYSP,6)

 +14               SET PSJSTAR="(1)^(2)^(3)^(4)^(5)^(6)^(7)^(9)"

 +15               DO ^PSJLIVFD

                   KILL ^PS(53.45,PSJSYSP,6)

               End DoDot:1

 +16       NEW PSIVX

 +17       FOR PSIVX=0:0

               SET PSIVX=$ORDER(^TMP("PSJI",$JOB,PSIVX))

               if 'PSIVX

                   QUIT 

               WRITE !,^(PSIVX,0)

 +18       KILL ^TMP("PSJI",$JOB)

 +19       QUIT 

LONG(Y)   ; Display long fields.

 +1        FOR X=1:1:$LENGTH(Y," ")

               if $X+$LENGTH($PIECE(Y," ",X))>$SELECT(LN<11

                   DO RC

               WRITE ?5,$PIECE(Y," ",X)," "

 +2        QUIT ""

WTPC      ; Write provider comments.

 +1        WRITE ?3,Y,!

 +2       ;

PAUSE     ;Hold display if end screen, do FF if eop.

 +1        IF $EXTRACT(IOST)="C"

               IF ($Y#IOSL)>20

                   NEW DIR,X,Y

                   SET DIR(0)="E"

                   DO ^DIR

                   if $DATA(DUOUT)!$DATA(DTOUT)

                       QUIT 

                   WRITE !

 +2        QUIT 

 +3       ;

RC        ; Print field by line number

 +1        NEW X,Y

           SET LN=LN+1

           if LN<11

               DO @LN

           WRITE !

 +2        QUIT 

 +3       ;

1         ; Type

 +1        WRITE ?56,"Type: "

           SET X=$$CODES^PSIVUTL(P(4),53.1,53)

           WRITE $SELECT($EXTRACT(X)="C":"CHEMO",1:X),$SELECT(P(23)'="":" ("_P(23)_")",1:""),$SELECT(P(5)=1:" (I)",P(5)=0:"(C)",1:"")

 +2        QUIT 

 +3       ;

2         ;Syringe Size

 +1        if P("SYRS")]""

               WRITE ?51,"Syr. Size: ",$EXTRACT(P("SYRS"),1,13)

           if $LENGTH(P("SYRS"))>13

               WRITE "..."

 +2        QUIT 

 +3       ;

3         ; IV Room

 +1        WRITE ?53,"IV Room: ",$PIECE(P("IVRM"),U,2)

 +2        QUIT 

 +3       ;

4         ; Start Date

 +1        SET X=""

           IF $DATA(PSIVNUM)

               if P("DTYP")

                   SET X=$SELECT(P(17)="P"!(PSIVAC="PN"):" ",1:"*")_$SELECT(P("DTYP")=1:"(12)",$EXTRACT(P("OT"))="I":"(10)",1:"(8)")

 +2        WRITE ?48-$LENGTH(X),X,?50,"Start Date: ",$$WDTE^PSIVUTL(P(2))

 +3        QUIT 

 +4       ;

5         ; Stop Date

 +1        SET X=""

           IF $DATA(PSIVNUM)

               if P("DTYP")

                   SET X=$SELECT(P(17)="P"!(PSIVAC="PN"):" ",1:"*")_$SELECT(P("DTYP")=1:"(13)",$EXTRACT(P("OT"))="I":"(11)",1:"(9)")

 +2        WRITE ?48-$LENGTH(X),X,?51,"Stop Date: ",$$WDTE^PSIVUTL(P(3))

 +3        QUIT 

 +4       ;

6         ; Log-in Date

 +1        WRITE ?50,"Login Date: ",$$WDTE^PSIVUTL(P("LOG"))

 +2        QUIT 

 +3       ;

7         ; Last fill date.

 +1        SET Y=$$WDTE^PSIVUTL(P("LF"))

           WRITE ?51,"Last Fill: ",$SELECT(Y="******":"** Not printed **",1:Y)

 +2        QUIT 

 +3       ;

8         ;Last fill qty.

 +1        WRITE ?52,"Quantity: ",+P("LFA")

 +2        QUIT 

 +3       ;

9         ; Entry Code

 +1        WRITE ?50,"Entry Code: ",$SELECT($PIECE(P("CLRK"),U,2)]"":$EXTRACT($PIECE(P("CLRK"),U,2),1,18),1:"*** Undefined")

 +2        QUIT 

 +3       ;

10        ; Provider

 +1       ;I P(17)="P",(+P("CLRK")=+P(6)) S X=""

           SET X=""

           IF $DATA(PSIVNUM)

               IF P("DTYP")

                   SET X=$SELECT(PSIVAC="PN":" ",1:"*")_$SELECT(P("DTYP")=1:"(14)",$EXTRACT(P("OT"))="I":"(12)",1:"(10)")

 +2        WRITE ?48-$LENGTH(X),X,?52,"Provider: ",$SELECT($PIECE(P(6),U,2)]"":$EXTRACT($PIECE(P(6),U,2),1,18),1:"*** Undefined")

 +3        QUIT 

ENNH(ON)  ;

 +1        IF ON'["V"

               DO GT531^PSIVORFA(DFN,ON)

               if P(4)=""

                   SET P(4)="P"

                   SET (P(2),P(3))=""

               NEW PSIV531

               SET PSIV531=1

 +2        IF ON["V"

               DO GT55^PSIVORFB

 +3        NEW UL

           SET UL=""

           SET $PIECE(UL,"-",70)=""

           WRITE !!,?5,UL,!,?5,"Patient: ",PSGP(0),?54,"Status: ",$SELECT(P(17)="DE":"DC (EDIT)",1:$$CODES^PSIVUTL(P(17),$SELECT(ON'["V":53.1,1:55.01),$SELECT(ON'["V":28,1:100))),!

 +4        DO ENPRO

 +5        QUIT