PSJLMUDE.m

PSJLMUDE ;BIR/MLM-SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;01 JUNE 00 / 2:40 PM

 ;;5.0; INPATIENT MEDICATIONS ;**7,47,50,63,64,58,80,116,110,111,164,175,201**;16 DEC 97;Build 2

  ;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)

  ;also chgs @init+23

 ;

 ; Reference to ^PS(55 is supported by DBIA# 2191

 ; Reference to ^PSDRUG is supported by DBIA 2192

 ;

INIT(PSGP,PSGORD) ;

 N D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR K ^TMP("PSJUDE",$J)

 K:$G(PSJNORD) PSGOEEF S PSJLN=1

 D CLEAN^VALM10

 S PSJL=$S($D(PSGEFN(1)):$E(" *",PSGEFN(1)+1)_"(1)",1:"   "),PSJL=$$SETSTR^VALM1("Orderable Item: "_PSGPDN_$$OINF^PSJDIN(PSGPD),PSJL,5,74) D  D SETTMP D:$G(PSGOEEF(108))!($G(PSGOEEF(101))) HILITE(1)

 . NEW Q,PSJDDA,PSJVD F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S PSJDDA(+$G(^(Q,0)))=""

 . S PSJVD=$$DINFLUD^PSJDIN(PSGPD,.PSJDDA)

 . S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,80)

 . D:PSJVD]"" CNTRL^VALM10(1,75,5,IORVON,IORVOFF,0)

 I $G(PSJORD)["P" D REQDT^PSJLIVMD(PSJORD)

 S PSJL="Instructions: "_PSGOINST D PTXT^PSJLMPRU(PSJL,"PSJUDE",6,80)

 S PSJL=$S($D(PSGEFN(2)):$E(" *",PSGEFN(2)+1)_"(2)",1:"    "),PSJL=$$SETSTR^VALM1("Dosage Ordered: "_PSGDO,PSJL,5,76) D SETTMP D:$G(PSGOEEF(109)) HILITE(2)

 I $G(PSGRDTX) S PSJDUR=$$FMTDUR^PSJLIVMD($P($G(PSGRDTX),U,2))

 I $G(PSJORD),($G(PSJDUR)="") S P=$S(PSJORD["U":5,PSJORD["V":"IV",PSJORD["P":"P",1:-1) S PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,P)

 S PSJL=$$SETSTR^VALM1("Duration: "_$G(PSJDUR),PSJL,11,25)

 S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:"    ")_"Start: "_$P(PSGSDN,U,2),PSJL,54,26) D:$G(PSGOEEF(10)) HILITE(3)

 I $G(PSGORD)["P" N ND0,OLDO S ND0=@(PSGOEEWF_"0)") I $P(ND0,"^",24)="R" S OLDO=$P(ND0,"^",25) I OLDO,(OLDO["U") D

 . N OSTRT,OSTRTN S OSTRT=$G(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)")),OSTRT=$P(OSTRT,"^",2) Q:'OSTRT  S OSTRTN=$$ENDTC^PSGMI(+OSTRT)

 . S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:"    ")_"Start: "_OSTRTN,PSJL,54,26)

 D SETTMP

 S PSJL=$S($D(PSGEFN(4)):$E(" *",PSGEFN(4)+1)_"(4)",1:"    "),PSJL=$$SETSTR^VALM1("Med Route: "_PSGMRN,PSJL,10,35) D:$G(PSGOEEF(3)) HILITE(4)

 I $G(PSJORD)["P" N PSGRNDT S PSGRNDT=$$LASTREN^PSJLMPRI(DFN,PSGORD) S:PSGRNDT PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)

 I '$G(PSGRNDT),$G(PSGRDTX) D

 . I $D(PSGRDTX)<10 S PSGRSDN=$$ENDTC^PSGMI(+PSGRDTX),PSJL=$$SETSTR^VALM1("REQUESTED START: "_PSGRSDN,PSJL,48,32) Q

 . I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$P($G(PSGSDN),U,2) S PSGRSDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRSD")),PSJL=$$SETSTR^VALM1("Calc Start: "_PSGRSDN,PSJL,53,32) D

 .. I PSGSD'=PSGRDTX(+PSJORD,"PSGRSD") D CNTRL^VALM10(5,53,80,IORVON,IORVOFF)

 ; Indirect reference in PSGOEEWF below refers to either ^PS(53.1 or ^PS(55,DFN,5,. Naked reference refers to full indirect reference

 I $G(PSJORD)["U" N ND14 S ND14=$G(@(PSGOEEWF_"14,0)")) I ND14]"" S ND14=$G(^($P(ND14,"^",3),0)),RNDT=$P(ND14,"^") I RNDT D

 . N PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+RNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)

 D SETTMP

 I PSGORD]"" S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)

 I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)

 S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(5)):$E(" *",PSGEFN(5)+1)_"(5)",1:"     ")_" Stop: "_$P(PSGFDN,U,2),PSJL,54,26) D SETTMP D:$G(PSGOEEF(25))!($G(PSGOEEF(34))) HILITE(5)

 S PSJL=$S($D(PSGEFN(6)):$E(" *",PSGEFN(6)+1)_"(6)",1:"   "),PSJL=$$SETSTR^VALM1("Schedule Type: "_PSGSTN,PSJL,6,45) D:$G(PSGOEEF(7)) HILITE(6)

 I $G(PSJORD)["P",$G(PSGRDTX(+$G(PSJORD),"PSGRFD")),$P($G(PSGFDN),U,2) S PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")),PSJL=$$SETSTR^VALM1("Calc Stop: "_PSGRFDN,PSJL,54,26) D

 . I PSGFD'=PSGRDTX(+PSJORD,"PSGRFD") D CNTRL^VALM10(7,54,80,IORVON,IORVOFF)

 D SETTMP

 S PSGSMN=$P("NO^YES",U,PSGSM+1)

 S PSJL=$S($D(PSGEFN(8)):$E(" *",PSGEFN(8)+1)_"(8)",1:"   "),PSJL=$$SETSTR^VALM1("Schedule: "_PSGSCH_$G(SCHMSG),PSJL,11,68) D SETTMP D:$G(PSGOEEF(26)) HILITE(8)

 S PSJL=$S($D(PSGEFN(9)):$E(" *",PSGEFN(9)+1)_"(9)",1:"   "),PSJL=$$SETSTR^VALM1("Admin Times: "_PSGAT,PSJL,8,71) D SETTMP D:$G(PSGOEEF(39))!($G(PSGOEEF(41))) HILITE(9)

 S PSJL=$S($D(PSGEFN(10)):$E(" *",PSGEFN(10)+1)_"(10)",1:"   "),PSJL=$$SETSTR^VALM1("Provider: "_PSGPRN,PSJL,11,68) D:$G(PSGOEEF(1)) HILITE(10) D SETTMP

 ;S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:"   ")_"Self Med: "_PSGSMN,PSJL,56,24) S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1("  (HS)",PSJL,71,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)

 S PSJL=$S($D(PSGEFN(11)):$E(" *",PSGEFN(11))_"(11)",1:"   ")_" Special Instructions"_$S($P(PSGSI,"^",2)=1:"!: ",1:": ")_$P(PSGSI,"^") D PTXT^PSJLMPRU(PSJL,"PSJUDE",1,80)

 S PSJL="" D SETTMP D:$G(PSGOEEF(8)) HILITE(11)

 ; E3R 16130

 I $O(^PS(53.45,PSJSYSP,2,1)) F  S PSJL="" D SETTMP Q:PSJLN>15

 S PSJL=$S($D(PSGEFN(12)):$E(" *",PSGEFN(12))_" (12)",1:"   ")_" Dispense Drug",PSJL=$$SETSTR^VALM1("U/D",PSJL,54,60),PSJL=$$SETSTR^VALM1("Inactive Date",PSJL,65,16) D SETTMP,CNTRL^VALM10(13,1,80,IOUON,IOUOFF,0)

 ;S $P(PSJL,"-",80)="" D SETTMP

 NEW PSJX

 F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S ND=$G(^(Q,0)) D

 .S D=$P(ND,"^"),PSGID=$P(ND,"^",3) I PSGID S PSGID=$$ENDTC^PSGMI(PSGID)

 .S D=$S(D="":"NOT FOUND",'$D(^PSDRUG(D,0)):D,$P(^(0),"^")]"":$P(^(0),"^"),1:D_";PSDRUG(")

 .S PSJL="      "_D_$$DDNF^PSJDIN(+ND),PSJL=$$SETSTR^VALM1($S($P(ND,"^",2):$S($P(ND,"^",2)=.5:"1/2",$P(ND,"^",2)=.25:"1/4",1:$P(ND,"^",2)),$P(ND,"^",2)=0:0,1:1),PSJL,54,63) S:PSGID PSJL=$$SETSTR^VALM1(PSGID,PSJL,65,16) D  D SETTMP

 ..S PSJX=$G(PSJX)+1

 ..I $G(PSGOEEF(109)) D CNTRL^VALM10(13+PSJX,7,73,IORVON_IOBON,IORVOFF_IOBOFF,0)

 I $S(PSGORD["P":$O(^PS(53.1,+$G(PSGORD),12,0)),1:$O(^PS(55,PSGP,5,+PSGORD,12,0))) S PSJL="Provider Comments:" D SETTMP S PSJL="" D

 .F Q=0:0 S Q=$S(PSGORD["P":$O(^PS(53.1,+$G(PSGORD),12,Q)),1:$O(^PS(55,PSGP,5,+PSGORD,12,Q))) Q:'Q  S PSJL=$G(^(Q,0)) D SETTMP

 D SETTMP S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:"   ")_"Self Med: "_PSGSMN,PSJL,1,24)

 S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1("  (HS)",PSJL,16,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)

 D SETTMP S PSJL="Entry By: "_PSGEBN,PSJL=$$SETSTR^VALM1("Entry Date: "_$P(PSGLIN,U,2),PSJL,51,39) D SETTMP

 I $G(PSGLRN) D SETTMP S PSJL="Renewed By: "_$$ENNPN^PSGMI($P(PSGLRN,"^",2)) D SETTMP

 D SETTMP S PSJL="(13)"_" Comments:"

 D:'$O(^PS(53.45,PSJSYSP,1,0)) SETTMP

 D SETTMP F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,1,Q)) Q:'Q  S PSJWPL=PSJL_$S($E(PSJL)=" ":"",1:" ")_$G(^(Q,0)),PSJL="" D DISPLAY

 D SETTMP

 I PSGORD["P",($P($G(^PS(53.1,+PSGORD,0)),U,9)="P"),$O(^PS(53.1,+PSGORD,10,0)) D

 .D SETTMP S PSJL="Order Checks:" D SETTMP

 .F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,10,Q)) Q:'Q  D

 ..S PSJL="" D SETTMP S PSJL=$G(^PS(53.1,+PSGORD,10,Q,0)) D SETTMP

 ..S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+PSGORD,10,Q,1)),U) D SETTMP

 ..S PSJL="Overriding Reason: " F X=0:0 S X=$O(^PS(53.1,+PSGORD,10,Q,2,X)) Q:'X   D

 ...S PSJL=PSJL_$G(^PS(53.1,+PSGORD,10,Q,2,X,0)) D SETTMP S PSJL="                   "

ACTFLG ;

 S ND4=$S(PSGORD["P":$G(^PS(53.1,+PSGORD,4)),1:$G(^PS(55,PSGP,5,+PSGORD,4)))

 S AT="",Y="12,13,D,18,19,H1,22,23,H0,15,16,R" F X=1:3:12 I $P(ND4,"^",$P(Y,",",X)),$P(ND4,"^",$P(Y,",",X+1)) S AT=$P(Y,",",X+2) Q

 I AT="",'$P(ND4,"^",$S($P(PSJSYSU,";",3)>1:3,1:1)) S AT="V"_$S($P(ND4,"^",18):"H1",$P(ND4,"^",22):"H0",$P(ND4,"^",15):"R",1:"")

 I AT]"" D

 .S PSJL="" D SETTMP

 .S PSJL="ORDER "_$S(AT["V":"NOT VERIFIED"_$S($P(AT,"V",2)="":"",1:" ("_$S(AT["H1":"ON HOLD",AT["H0":"OFF HOLD",1:"RENEWAL")_")"),1:"MARKED TO BE "_$S(AT["D":"CANCELLED",AT["H1":"PLACED ON HOLD",AT["H0":"TAKEN OFF OF HOLD",1:"RENEWED"))

 I AT'["V",AT["H1",$D(^PS(55,PSGP,5.1)) S AT=^(5.1) I $P(AT,"^",7),$P(AT,"^",10)]"" S PSJL=PSJL_"  ("_$P(AT,"^",10)_")"

 D SETTMP

 S VALMCNT=PSJLN-1

 K PSGSMN,Q,Y,Y1,Y2,PSGLRN

 S VALM("TITLE")=PSGSTAT_" UNIT DOSE "_$S((PSGSTAT="PENDING")&($G(PSGPRIO)]""):"("_PSGPRIO_")",$G(PSGPRIO)="DONE":"("_PSGPRIO_")",1:"") I $D(PSJLMP2) S VALMBG=16 K PSJLMP2

TEST ;

 I $G(PSGPFLG) S VALMSG="INVALID ORDERABLE ITEM"

 I $G(PSGDI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" DISPENSE DRUG"

 I $G(PSGPI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" PROVIDER"

 Q

DISPLAY ;

 S PSJL=PSJWPL D SETTMP

 ;F X=1:1 S WRD=$P(PSJWPL," ",X) Q:WRD=""  D

 ;.I $L(PSJL_" "_WRD)'<80 D SETTMP S PSJL=$P(PSJWPL,PSJL,2) S:$E(PSJL,1)=" " PSJL=$E(PSJL,2,999),PSJWPL="" Q

 ;.S PSJL=PSJL_$S(PSJL="":"",1:" ")_WRD

 Q

 ;

SETTMP ;

 S ^TMP("PSJUDE",$J,PSJLN,0)=PSJL,PSJLN=PSJLN+1,PSJL=""

 Q

 ;

HILITE(FLD) ; 

 N COL,LIN,WID,X

 ;Q:'$G(PSGOEENO)

 S X="$T("_FLD_"^PSJLMUDE)",@("X="_X),X=$P(X,";;",2),LIN=+X,COL=$P(X,",",2),LAB=$P(X,",",3),X=$P(X,",",4),WID=(LAB+$L(@X))

 ;D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IOINORM,0)

 I FLD=7 S LIN=+$G(PSJLN)-1 Q:LIN<13

 D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)

 Q

 ;

1 ;;1,5,16,PSGPDN

2 ;;3,5,16,PSGDO

3 ;;4,58,7,PSGSDN

4 ;;5,10,11,PSGMRN

5 ;;6,59,6,PSGFDN

6 ;;7,6,15,PSGSTN

7 ;;18,5,14,PSGSMN

8 ;;8,11,12,PSGSCH

9 ;;9,8,13,PSGAT

10 ;;10,11,10,PSGPRN

11 ;;11,7,22,PSGSI

ENKILL ;

 K PSGAT,PSGEB,PSGEFN,PSGFD,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSGOMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD,PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,PSGSM Q

PSJLMUDE  ;BIR/MLM-SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;01 JUNE 00 / 2:40 PM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**7,47,50,63,64,58,80,116,110,111,164,175,201**;16 DEC 97;Build 2

 +2       ;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)

 +3       ;also chgs @init+23

 +4       ;

 +5       ; Reference to ^PS(55 is supported by DBIA# 2191

 +6       ; Reference to ^PSDRUG is supported by DBIA 2192

 +7       ;

INIT(PSGP,PSGORD) ;

 +1        NEW D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR

           KILL ^TMP("PSJUDE",$JOB)

 +2        IF $GET(PSJNORD)

               KILL PSGOEEF

           SET PSJLN=1

 +3        DO CLEAN^VALM10

 +4        SET PSJL=$SELECT($DATA(PSGEFN(1)):$EXTRACT(" *",PSGEFN(1)+1)_"(1)",1:"   ")

           SET PSJL=$$SETSTR^VALM1("Orderable Item: "_PSGPDN_$$OINF^PSJDIN(PSGPD),PSJL,5,74)

           Begin DoDot:1

 +5            NEW Q,PSJDDA,PSJVD

               FOR Q=0:0

                   SET Q=$ORDER(^PS(53.45,PSJSYSP,2,Q))

                   IF 'Q

                       QUIT 

                   SET PSJDDA(+$GET(^(Q,0)))=""

 +6            SET PSJVD=$$DINFLUD^PSJDIN(PSGPD,.PSJDDA)

 +7            SET PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,80)

 +8            IF PSJVD]""

                   DO CNTRL^VALM10(1,75,5,IORVON,IORVOFF,0)

           End DoDot:1

           DO SETTMP

           IF $GET(PSGOEEF(108))!($GET(PSGOEEF(101)))

               DO HILITE(1)

 +9        IF $GET(PSJORD)["P"

               DO REQDT^PSJLIVMD(PSJORD)

 +10       SET PSJL="Instructions: "_PSGOINST

           DO PTXT^PSJLMPRU(PSJL,"PSJUDE",6,80)

 +11       SET PSJL=$SELECT($DATA(PSGEFN(2)):$EXTRACT(" *",PSGEFN(2)+1)_"(2)",1:"    ")

           SET PSJL=$$SETSTR^VALM1("Dosage Ordered: "_PSGDO,PSJL,5,76)

           DO SETTMP

           IF $GET(PSGOEEF(109))

               DO HILITE(2)

 +12       IF $GET(PSGRDTX)

               SET PSJDUR=$$FMTDUR^PSJLIVMD($PIECE($GET(PSGRDTX),U,2))

 +13       IF $GET(PSJORD)

               IF ($GET(PSJDUR)="")

                   SET P=$SELECT(PSJORD["U":5,PSJORD["V":"IV",PSJORD["P":"P",1:-1)

                   SET PSJDUR=$$GETDUR^PSJLIVMD(PSGP,+PSJORD,P)

 +14       SET PSJL=$$SETSTR^VALM1("Duration: "_$GET(PSJDUR),PSJL,11,25)

 +15       SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(3)):$EXTRACT(" *",PSGEFN(3)+1)_"(3)",1:"    ")_"Start: "_$PIECE(PSGSDN,U,2),PSJL,54,26)

           IF $GET(PSGOEEF(10))

               DO HILITE(3)

 +16       IF $GET(PSGORD)["P"

               NEW ND0,OLDO

               SET ND0=@(PSGOEEWF_"0)")

               IF $PIECE(ND0,"^",24)="R"

                   SET OLDO=$PIECE(ND0,"^",25)

                   IF OLDO

                       IF (OLDO["U")

                           Begin DoDot:1

 +17                           NEW OSTRT,OSTRTN

                               SET OSTRT=$GET(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)"))

                               SET OSTRT=$PIECE(OSTRT,"^",2)

                               IF 'OSTRT

                                   QUIT 

                               SET OSTRTN=$$ENDTC^PSGMI(+OSTRT)

 +18                           SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(3)):$EXTRACT(" *",PSGEFN(3)+1)_"(3)",1:"    ")_"Start: "_OSTRTN,PSJL,54,26)

                           End DoDot:1

 +19       DO SETTMP

 +20       SET PSJL=$SELECT($DATA(PSGEFN(4)):$EXTRACT(" *",PSGEFN(4)+1)_"(4)",1:"    ")

           SET PSJL=$$SETSTR^VALM1("Med Route: "_PSGMRN,PSJL,10,35)

           IF $GET(PSGOEEF(3))

               DO HILITE(4)

 +21       IF $GET(PSJORD)["P"

               NEW PSGRNDT

               SET PSGRNDT=$$LASTREN^PSJLMPRI(DFN,PSGORD)

               IF PSGRNDT

                   SET PSGRNDT=$$ENDTC^PSGMI(+PSGRNDT)

                   SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)

 +22       IF '$GET(PSGRNDT)

               IF $GET(PSGRDTX)

                   Begin DoDot:1

 +23                   IF $DATA(PSGRDTX)<10

                           SET PSGRSDN=$$ENDTC^PSGMI(+PSGRDTX)

                           SET PSJL=$$SETSTR^VALM1("REQUESTED START: "_PSGRSDN,PSJL,48,32)

                           QUIT 

 +24                   IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRSD"))

                           IF $PIECE($GET(PSGSDN),U,2)

                               SET PSGRSDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRSD"))

                               SET PSJL=$$SETSTR^VALM1("Calc Start: "_PSGRSDN,PSJL,53,32)

                               Begin DoDot:2

 +25                               IF PSGSD'=PSGRDTX(+PSJORD,"PSGRSD")

                                       DO CNTRL^VALM10(5,53,80,IORVON,IORVOFF)

                               End DoDot:2

                   End DoDot:1

 +26      ; Indirect reference in PSGOEEWF below refers to either ^PS(53.1 or ^PS(55,DFN,5,. Naked reference refers to full indirect reference

 +27       IF $GET(PSJORD)["U"

               NEW ND14

               SET ND14=$GET(@(PSGOEEWF_"14,0)"))

               IF ND14]""

                   SET ND14=$GET(^($PIECE(ND14,"^",3),0))

                   SET RNDT=$PIECE(ND14,"^")

                   IF RNDT

                       Begin DoDot:1

 +28                       NEW PSGRNDT

                           SET PSGRNDT=$$ENDTC^PSGMI(+RNDT)

                           SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)

                       End DoDot:1

 +29       DO SETTMP

 +30       IF PSGORD]""

               SET PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)

 +31       IF $GET(PSJBCMA)]""

               SET PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)

 +32       SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(5)):$EXTRACT(" *",PSGEFN(5)+1)_"(5)",1:"     ")_" Stop: "_$PIECE(PSGFDN,U,2),PSJL,54,26)

           DO SETTMP

           IF $GET(PSGOEEF(25))!($GET(PSGOEEF(34)))

               DO HILITE(5)

 +33       SET PSJL=$SELECT($DATA(PSGEFN(6)):$EXTRACT(" *",PSGEFN(6)+1)_"(6)",1:"   ")

           SET PSJL=$$SETSTR^VALM1("Schedule Type: "_PSGSTN,PSJL,6,45)

           IF $GET(PSGOEEF(7))

               DO HILITE(6)

 +34       IF $GET(PSJORD)["P"

               IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRFD"))

                   IF $PIECE($GET(PSGFDN),U,2)

                       SET PSGRFDN=$$ENDTC^PSGMI(PSGRDTX(+PSJORD,"PSGRFD"))

                       SET PSJL=$$SETSTR^VALM1("Calc Stop: "_PSGRFDN,PSJL,54,26)

                       Begin DoDot:1

 +35                       IF PSGFD'=PSGRDTX(+PSJORD,"PSGRFD")

                               DO CNTRL^VALM10(7,54,80,IORVON,IORVOFF)

                       End DoDot:1

 +36       DO SETTMP

 +37       SET PSGSMN=$PIECE("NO^YES",U,PSGSM+1)

 +38       SET PSJL=$SELECT($DATA(PSGEFN(8)):$EXTRACT(" *",PSGEFN(8)+1)_"(8)",1:"   ")

           SET PSJL=$$SETSTR^VALM1("Schedule: "_PSGSCH_$GET(SCHMSG),PSJL,11,68)

           DO SETTMP

           IF $GET(PSGOEEF(26))

               DO HILITE(8)

 +39       SET PSJL=$SELECT($DATA(PSGEFN(9)):$EXTRACT(" *",PSGEFN(9)+1)_"(9)",1:"   ")

           SET PSJL=$$SETSTR^VALM1("Admin Times: "_PSGAT,PSJL,8,71)

           DO SETTMP

           IF $GET(PSGOEEF(39))!($GET(PSGOEEF(41)))

               DO HILITE(9)

 +40       SET PSJL=$SELECT($DATA(PSGEFN(10)):$EXTRACT(" *",PSGEFN(10)+1)_"(10)",1:"   ")

           SET PSJL=$$SETSTR^VALM1("Provider: "_PSGPRN,PSJL,11,68)

           IF $GET(PSGOEEF(1))

               DO HILITE(10)

           DO SETTMP

 +41      ;S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:"   ")_"Self Med: "_PSGSMN,PSJL,56,24) S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1("  (HS)",PSJL,71,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)

 +42       SET PSJL=$SELECT($DATA(PSGEFN(11)):$EXTRACT(" *",PSGEFN(11))_"(11)",1:"   ")_" Special Instructions"_$SELECT($PIECE(PSGSI,"^",2)=1:"!: ",1:": ")_$PIECE(PSGSI,"^")

           DO PTXT^PSJLMPRU(PSJL,"PSJUDE",1,80)

 +43       SET PSJL=""

           DO SETTMP

           IF $GET(PSGOEEF(8))

               DO HILITE(11)

 +44      ; E3R 16130

 +45       IF $ORDER(^PS(53.45,PSJSYSP,2,1))

               FOR 

                   SET PSJL=""

                   DO SETTMP

                   IF PSJLN>15

                       QUIT 

 +46       SET PSJL=$SELECT($DATA(PSGEFN(12)):$EXTRACT(" *",PSGEFN(12))_" (12)",1:"   ")_" Dispense Drug"

           SET PSJL=$$SETSTR^VALM1("U/D",PSJL,54,60)

           SET PSJL=$$SETSTR^VALM1("Inactive Date",PSJL,65,16)

           DO SETTMP

           DO CNTRL^VALM10(13,1,80,IOUON,IOUOFF,0)

 +47      ;S $P(PSJL,"-",80)="" D SETTMP

 +48       NEW PSJX

 +49       FOR Q=0:0

               SET Q=$ORDER(^PS(53.45,PSJSYSP,2,Q))

               IF 'Q

                   QUIT 

               SET ND=$GET(^(Q,0))

               Begin DoDot:1

 +50               SET D=$PIECE(ND,"^")

                   SET PSGID=$PIECE(ND,"^",3)

                   IF PSGID

                       SET PSGID=$$ENDTC^PSGMI(PSGID)

 +51               SET D=$SELECT(D="":"NOT FOUND",'$DATA(^PSDRUG(D,0)):D,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:D_";PSDRUG(")

 +52               SET PSJL="      "_D_$$DDNF^PSJDIN(+ND)

                   SET PSJL=$$SETSTR^VALM1($SELECT($PIECE(ND,"^",2):$SELECT($PIECE(ND,"^",2)=.5:"1/2",$PIECE(ND,"^",2)=.25:"1/4",1:$PIECE(ND,"^",2)),$PIECE(ND,"^",2)=0:0,1:1),PSJL,54,63)

                   IF PSGID

                       SET PSJL=$$SETSTR^VALM1(PSGID,PSJL,65,16)

                   Begin DoDot:2

 +53                   SET PSJX=$GET(PSJX)+1

 +54                   IF $GET(PSGOEEF(109))

                           DO CNTRL^VALM10(13+PSJX,7,73,IORVON_IOBON,IORVOFF_IOBOFF,0)

                   End DoDot:2

                   DO SETTMP

               End DoDot:1

 +55       IF $SELECT(PSGORD["P":$ORDER(^PS(53.1,+$GET(PSGORD),12,0)),1:$ORDER(^PS(55,PSGP,5,+PSGORD,12,0)))

               SET PSJL="Provider Comments:"

               DO SETTMP

               SET PSJL=""

               Begin DoDot:1

 +56               FOR Q=0:0

                       SET Q=$SELECT(PSGORD["P":$ORDER(^PS(53.1,+$GET(PSGORD),12,Q)),1:$ORDER(^PS(55,PSGP,5,+PSGORD,12,Q)))

                       IF 'Q

                           QUIT 

                       SET PSJL=$GET(^(Q,0))

                       DO SETTMP

               End DoDot:1

 +57       DO SETTMP

           SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(7)):$EXTRACT(" *",PSGEFN(7)+1)_"(7)",1:"   ")_"Self Med: "_PSGSMN,PSJL,1,24)

 +58       IF PSGSM&PSGHSM

               SET PSJL=$$SETSTR^VALM1("  (HS)",PSJL,16,7)

           DO SETTMP

           IF $GET(PSGOEEF(5))

               DO HILITE(7)

 +59       DO SETTMP

           SET PSJL="Entry By: "_PSGEBN

           SET PSJL=$$SETSTR^VALM1("Entry Date: "_$PIECE(PSGLIN,U,2),PSJL,51,39)

           DO SETTMP

 +60       IF $GET(PSGLRN)

               DO SETTMP

               SET PSJL="Renewed By: "_$$ENNPN^PSGMI($PIECE(PSGLRN,"^",2))

               DO SETTMP

 +61       DO SETTMP

           SET PSJL="(13)"_" Comments:"

 +62       IF '$ORDER(^PS(53.45,PSJSYSP,1,0))

               DO SETTMP

 +63       DO SETTMP

           FOR Q=0:0

               SET Q=$ORDER(^PS(53.45,PSJSYSP,1,Q))

               IF 'Q

                   QUIT 

               SET PSJWPL=PSJL_$SELECT($EXTRACT(PSJL)=" ":"",1:" ")_$GET(^(Q,0))

               SET PSJL=""

               DO DISPLAY

 +64       DO SETTMP

 +65       IF PSGORD["P"

               IF ($PIECE($GET(^PS(53.1,+PSGORD,0)),U,9)="P")

                   IF $ORDER(^PS(53.1,+PSGORD,10,0))

                       Begin DoDot:1

 +66                       DO SETTMP

                           SET PSJL="Order Checks:"

                           DO SETTMP

 +67                       FOR Q=0:0

                               SET Q=$ORDER(^PS(53.1,+PSGORD,10,Q))

                               IF 'Q

                                   QUIT 

                               Begin DoDot:2

 +68                               SET PSJL=""

                                   DO SETTMP

                                   SET PSJL=$GET(^PS(53.1,+PSGORD,10,Q,0))

                                   DO SETTMP

 +69                               SET PSJL="Overriding Provider: "_$PIECE($GET(^PS(53.1,+PSGORD,10,Q,1)),U)

                                   DO SETTMP

 +70                               SET PSJL="Overriding Reason: "

                                   FOR X=0:0

                                       SET X=$ORDER(^PS(53.1,+PSGORD,10,Q,2,X))

                                       IF 'X

                                           QUIT 

                                       Begin DoDot:3

 +71                                       SET PSJL=PSJL_$GET(^PS(53.1,+PSGORD,10,Q,2,X,0))

                                           DO SETTMP

                                           SET PSJL="                   "

                                       End DoDot:3

                               End DoDot:2

                       End DoDot:1

ACTFLG    ;

 +1        SET ND4=$SELECT(PSGORD["P":$GET(^PS(53.1,+PSGORD,4)),1:$GET(^PS(55,PSGP,5,+PSGORD,4)))

 +2        SET AT=""

           SET Y="12,13,D,18,19,H1,22,23,H0,15,16,R"

           FOR X=1:3:12

               IF $PIECE(ND4,"^",$PIECE(Y,",",X))

                   IF $PIECE(ND4,"^",$PIECE(Y,",",X+1))

                       SET AT=$PIECE(Y,",",X+2)

                       QUIT 

 +3        IF AT=""

               IF '$PIECE(ND4,"^",$SELECT($PIECE(PSJSYSU,";",3)>1:3,1:1))

                   SET AT="V"_$SELECT($PIECE(ND4,"^",18):"H1",$PIECE(ND4,"^",22):"H0",$PIECE(ND4,"^",15):"R",1:"")

 +4        IF AT]""

               Begin DoDot:1

 +5                SET PSJL=""

                   DO SETTMP

 +6               SET PSJL="ORDER "_$SELECT(AT["V":"NOT VERIFIED"_$SELECT($PIECE(AT,"V",2)="":"",1:" ("_...

                   ... $SELECT(AT["H1":"ON HOLD",AT["H0":"OFF HOLD",1:"RENEWAL")_")"),1:"MARKED TO BE "_$SELECT(AT["D":"CANCELLED",AT["H1":"PLACED ON HOLD",AT["H0":"TAKEN OFF OF HOLD",1:"RENEWED"))

               End DoDot:1

 +7        IF AT'["V"

               IF AT["H1"

                   IF $DATA(^PS(55,PSGP,5.1))

                       SET AT=^(5.1)

                       IF $PIECE(AT,"^",7)

                           IF $PIECE(AT,"^",10)]""

                               SET PSJL=PSJL_"  ("_$PIECE(AT,"^",10)_")"

 +8        DO SETTMP

 +9        SET VALMCNT=PSJLN-1

 +10       KILL PSGSMN,Q,Y,Y1,Y2,PSGLRN

 +11       SET VALM("TITLE")=PSGSTAT_" UNIT DOSE "_$SELECT((PSGSTAT="PENDING")&($GET(PSGPRIO)]""):"("_PSGPRIO_")",$GET(PSGPRIO)="DONE":"("_PSGPRIO_")",1:"")

           IF $DATA(PSJLMP2)