Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMUDE.m

    r613 r623  
    1 PSJLMUDE        ;BIR/MLM-SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;01 JUNE 00 / 2:40 PM
    2         ;;5.0; INPATIENT MEDICATIONS ;**7,47,50,63,64,58,80,116,110,111,164,175,201**;16 DEC 97;Build 2
    3          ;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)
    4          ;also chgs @init+23
    5         ;
    6         ; Reference to ^PS(55 is supported by DBIA# 2191
    7         ; Reference to ^PSDRUG is supported by DBIA 2192
    8         ;
    9 INIT(PSGP,PSGORD)       ;
    10         N D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR K ^TMP("PSJUDE",$J)
    11         K:$G(PSJNORD) PSGOEEF S PSJLN=1
    12         D CLEAN^VALM10
    13         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)
    14         . NEW Q,PSJDDA,PSJVD F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S PSJDDA(+$G(^(Q,0)))=""
    15         . S PSJVD=$$DINFLUD^PSJDIN(PSGPD,.PSJDDA)
    16         . S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,80)
    17         . D:PSJVD]"" CNTRL^VALM10(1,75,5,IORVON,IORVOFF,0)
    18         I $G(PSJORD)["P" D REQDT^PSJLIVMD(PSJORD)
    19         S PSJL="Instructions: "_PSGOINST D PTXT^PSJLMPRU(PSJL,"PSJUDE",6,80)
    20         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)
    21         I $G(PSGRDTX) S PSJDUR=$$FMTDUR^PSJLIVMD($P($G(PSGRDTX),U,2))
    22         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)
    23         S PSJL=$$SETSTR^VALM1("Duration: "_$G(PSJDUR),PSJL,11,25)
    24         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)
    25         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
    26         . N OSTRT,OSTRTN S OSTRT=$G(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)")),OSTRT=$P(OSTRT,"^",2) Q:'OSTRT  S OSTRTN=$$ENDTC^PSGMI(+OSTRT)
    27         . S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:"    ")_"Start: "_OSTRTN,PSJL,54,26)
    28         D SETTMP
    29         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)
    30         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)
    31         I '$G(PSGRNDT),$G(PSGRDTX) D
    32         . I $D(PSGRDTX)<10 S PSGRSDN=$$ENDTC^PSGMI(+PSGRDTX),PSJL=$$SETSTR^VALM1("REQUESTED START: "_PSGRSDN,PSJL,48,32) Q
    33         . 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
    34         .. I PSGSD'=PSGRDTX(+PSJORD,"PSGRSD") D CNTRL^VALM10(5,53,80,IORVON,IORVOFF)
    35         ; Indirect reference in PSGOEEWF below refers to either ^PS(53.1 or ^PS(55,DFN,5,. Naked reference refers to full indirect reference
    36         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
    37         . N PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+RNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)
    38         D SETTMP
    39         I PSGORD]"" S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)
    40         I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
    41         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)
    42         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)
    43         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
    44         . I PSGFD'=PSGRDTX(+PSJORD,"PSGRFD") D CNTRL^VALM10(7,54,80,IORVON,IORVOFF)
    45         D SETTMP
    46         S PSGSMN=$P("NO^YES",U,PSGSM+1)
    47         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)
    48         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)
    49         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
    50         ;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)
    51         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)
    52         S PSJL="" D SETTMP D:$G(PSGOEEF(8)) HILITE(11)
    53         ; E3R 16130
    54         I $O(^PS(53.45,PSJSYSP,2,1)) F  S PSJL="" D SETTMP Q:PSJLN>15
    55         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)
    56         ;S $P(PSJL,"-",80)="" D SETTMP
    57         NEW PSJX
    58         F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S ND=$G(^(Q,0)) D
    59         .S D=$P(ND,"^"),PSGID=$P(ND,"^",3) I PSGID S PSGID=$$ENDTC^PSGMI(PSGID)
    60         .S D=$S(D="":"NOT FOUND",'$D(^PSDRUG(D,0)):D,$P(^(0),"^")]"":$P(^(0),"^"),1:D_";PSDRUG(")
    61         .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
    62         ..S PSJX=$G(PSJX)+1
    63         ..I $G(PSGOEEF(109)) D CNTRL^VALM10(13+PSJX,7,73,IORVON_IOBON,IORVOFF_IOBOFF,0)
    64         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
    65         .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
    66         D SETTMP S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:"   ")_"Self Med: "_PSGSMN,PSJL,1,24)
    67         S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1("  (HS)",PSJL,16,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)
    68         D SETTMP S PSJL="Entry By: "_PSGEBN,PSJL=$$SETSTR^VALM1("Entry Date: "_$P(PSGLIN,U,2),PSJL,51,39) D SETTMP
    69         I $G(PSGLRN) D SETTMP S PSJL="Renewed By: "_$$ENNPN^PSGMI($P(PSGLRN,"^",2)) D SETTMP
    70         D SETTMP S PSJL="(13)"_" Comments:"
    71         D:'$O(^PS(53.45,PSJSYSP,1,0)) SETTMP
    72         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
    73         D SETTMP
    74         I PSGORD["P",($P($G(^PS(53.1,+PSGORD,0)),U,9)="P"),$O(^PS(53.1,+PSGORD,10,0)) D
    75         .D SETTMP S PSJL="Order Checks:" D SETTMP
    76         .F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,10,Q)) Q:'Q  D
    77         ..S PSJL="" D SETTMP S PSJL=$G(^PS(53.1,+PSGORD,10,Q,0)) D SETTMP
    78         ..S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+PSGORD,10,Q,1)),U) D SETTMP
    79         ..S PSJL="Overriding Reason: " F X=0:0 S X=$O(^PS(53.1,+PSGORD,10,Q,2,X)) Q:'X   D
    80         ...S PSJL=PSJL_$G(^PS(53.1,+PSGORD,10,Q,2,X,0)) D SETTMP S PSJL="                   "
    81 ACTFLG  ;
    82         S ND4=$S(PSGORD["P":$G(^PS(53.1,+PSGORD,4)),1:$G(^PS(55,PSGP,5,+PSGORD,4)))
    83         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
    84         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:"")
    85         I AT]"" D
    86         .S PSJL="" D SETTMP
    87         .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"))
    88         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)_")"
    89         D SETTMP
    90         S VALMCNT=PSJLN-1
    91         K PSGSMN,Q,Y,Y1,Y2,PSGLRN
    92         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
    93 TEST    ;
    94         I $G(PSGPFLG) S VALMSG="INVALID ORDERABLE ITEM"
    95         I $G(PSGDI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" DISPENSE DRUG"
    96         I $G(PSGPI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" PROVIDER"
    97         Q
    98 DISPLAY ;
    99         S PSJL=PSJWPL D SETTMP
    100         ;F X=1:1 S WRD=$P(PSJWPL," ",X) Q:WRD=""  D
    101         ;.I $L(PSJL_" "_WRD)'<80 D SETTMP S PSJL=$P(PSJWPL,PSJL,2) S:$E(PSJL,1)=" " PSJL=$E(PSJL,2,999),PSJWPL="" Q
    102         ;.S PSJL=PSJL_$S(PSJL="":"",1:" ")_WRD
    103         Q
    104         ;
    105 SETTMP  ;
    106         S ^TMP("PSJUDE",$J,PSJLN,0)=PSJL,PSJLN=PSJLN+1,PSJL=""
    107         Q
    108         ;
    109 HILITE(FLD)     ;
    110         N COL,LIN,WID,X
    111         ;Q:'$G(PSGOEENO)
    112         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))
    113         ;D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IOINORM,0)
    114         I FLD=7 S LIN=+$G(PSJLN)-1 Q:LIN<13
    115         D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)
    116         Q
    117         ;
    118 1       ;;1,5,16,PSGPDN
    119 2       ;;3,5,16,PSGDO
    120 3       ;;4,58,7,PSGSDN
    121 4       ;;5,10,11,PSGMRN
    122 5       ;;6,59,6,PSGFDN
    123 6       ;;7,6,15,PSGSTN
    124 7       ;;18,5,14,PSGSMN
    125 8       ;;8,11,12,PSGSCH
    126 9       ;;9,8,13,PSGAT
    127 10      ;;10,11,10,PSGPRN
    128 11      ;;11,7,22,PSGSI
    129 ENKILL  ;
    130         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
     1PSJLMUDE ;BIR/MLM-SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;01 JUNE 00 / 2:40 PM
     2 ;;5.0; INPATIENT MEDICATIONS ;**7,47,50,63,64,58,80,116,110,111,164,175**;16 DEC 97;Build 18
     3 ;NFI-UD Fr#:2 chgs@init+4 to display non-formulary (N/F)
     4 ;also chgs @init+23
     5 ;
     6 ; Reference to ^PS(55 is supported by DBIA# 2191
     7 ; Reference to ^PSDRUG is supported by DBIA 2192
     8 ;
     9INIT(PSGP,PSGORD) ;
     10 N D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR K ^TMP("PSJUDE",$J)
     11 K:$G(PSJNORD) PSGOEEF S PSJLN=1
     12 D CLEAN^VALM10
     13 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)
     14 . N Q,PSJDDA,PSJVD F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S PSJDDA(+$G(^(Q,0)))=""
     15 . S PSJVD=$$DINFLUD^PSJDIN(PSGPD,.PSJDDA)
     16 . S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,75,80)
     17 . D:PSJVD]"" CNTRL^VALM10(1,75,5,IORVON,IORVOFF,0)
     18 I $G(PSJORD)["P" D REQDT^PSJLIVMD(PSJORD)
     19 S PSJL="Instructions: "_PSGOINST D PTXT^PSJLMPRU(PSJL,"PSJUDE",6,120)
     20 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)
     21 I $G(PSGRDTX) S PSJDUR=$$FMTDUR^PSJLIVMD($P($G(PSGRDTX),U,2))
     22 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)
     23 S PSJL=$$SETSTR^VALM1("Duration: "_$G(PSJDUR),PSJL,11,25)
     24 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)
     25 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
     26 . N OSTRT,OSTRTN S OSTRT=$G(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)")),OSTRT=$P(OSTRT,"^",2) Q:'OSTRT  S OSTRTN=$$ENDTC^PSGMI(+OSTRT)
     27 . S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:"    ")_"Start: "_OSTRTN,PSJL,54,26)
     28 D SETTMP
     29 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)
     30 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)
     31 I '$G(PSGRNDT),$G(PSGRDTX) D
     32 . I $D(PSGRDTX)<10 S PSGRSDN=$$ENDTC^PSGMI(+PSGRDTX),PSJL=$$SETSTR^VALM1("REQUESTED START: "_PSGRSDN,PSJL,48,32) Q
     33 . 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
     34 .. I PSGSD'=PSGRDTX(+PSJORD,"PSGRSD") D CNTRL^VALM10(5,53,80,IORVON,IORVOFF)
     35 ; Indirect reference in PSGOEEWF below refers to either ^PS(53.1 or ^PS(55,DFN,5,. Naked reference refers to full indirect reference
     36 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
     37 . N PSGRNDT S PSGRNDT=$$ENDTC^PSGMI(+RNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,56,32)
     38 D SETTMP
     39 I PSGORD]"" S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)
     40 I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
     41 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)
     42 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)
     43 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
     44 . I PSGFD'=PSGRDTX(+PSJORD,"PSGRFD") D CNTRL^VALM10(7,54,80,IORVON,IORVOFF)
     45 D SETTMP
     46 S PSGSMN=$P("NO^YES",U,PSGSM+1)
     47 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)
     48 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)
     49 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
     50 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)
     51 S PSJL="" D SETTMP D:$G(PSGOEEF(8)) HILITE(11)
     52 ; E3R 16130
     53 I $O(^PS(53.45,PSJSYSP,2,1)) F  S PSJL="" D SETTMP Q:PSJLN>15
     54 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)
     55 N PSJX,PSGID
     56 F Q=0:0 S Q=$O(^PS(53.45,PSJSYSP,2,Q)) Q:'Q  S ND=$G(^(Q,0)) D
     57 .S D=$P(ND,"^"),PSGID=$P(ND,"^",3) I PSGID S PSGID=$$ENDTC^PSGMI(PSGID)
     58 .S D=$S(D="":"NOT FOUND",'$D(^PSDRUG(D,0)):D,$P(^(0),"^")]"":$P(^(0),"^"),1:D_";PSDRUG(")
     59 .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
     60 ..S PSJX=$G(PSJX)+1
     61 ..I $G(PSGOEEF(109)) D CNTRL^VALM10(13+PSJX,7,73,IORVON_IOBON,IORVOFF_IOBOFF,0)
     62 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
     63 .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
     64 D SETTMP S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(7)):$E(" *",PSGEFN(7)+1)_"(7)",1:"   ")_"Self Med: "_PSGSMN,PSJL,1,24)
     65 S:PSGSM&PSGHSM PSJL=$$SETSTR^VALM1("  (HS)",PSJL,16,7) D SETTMP D:$G(PSGOEEF(5)) HILITE(7)
     66 D SETTMP S PSJL="Entry By: "_PSGEBN,PSJL=$$SETSTR^VALM1("Entry Date: "_$P(PSGLIN,U,2),PSJL,51,39) D SETTMP
     67 I $G(PSGLRN) D SETTMP S PSJL="Renewed By: "_$$ENNPN^PSGMI($P(PSGLRN,"^",2)) D SETTMP
     68 D SETTMP S PSJL="(13)"_" Comments:"
     69 D:'$O(^PS(53.45,PSJSYSP,1,0)) SETTMP
     70 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
     71 D SETTMP
     72 I PSGORD["P",($P($G(^PS(53.1,+PSGORD,0)),U,9)="P"),$O(^PS(53.1,+PSGORD,10,0)) D
     73 .D SETTMP S PSJL="Order Checks:" D SETTMP
     74 .F Q=0:0 S Q=$O(^PS(53.1,+PSGORD,10,Q)) Q:'Q  D
     75 ..S PSJL="" D SETTMP S PSJL=$G(^PS(53.1,+PSGORD,10,Q,0)) S PSJWPL=PSJL D DISPLAY
     76 ..S PSJL="Overriding Provider: "_$P($G(^PS(53.1,+PSGORD,10,Q,1)),U) D SETTMP
     77 ..S PSJL="Overriding Reason: " F X=0:0 S X=$O(^PS(53.1,+PSGORD,10,Q,2,X)) Q:'X   D
     78 ...S PSJL=PSJL_$G(^PS(53.1,+PSGORD,10,Q,2,X,0)) D SETTMP S PSJL="                   "
     79ACTFLG ;
     80 N ND4,AT,Y,X
     81 S ND4=$S(PSGORD["P":$G(^PS(53.1,+PSGORD,4)),1:$G(^PS(55,PSGP,5,+PSGORD,4)))
     82 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
     83 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:"")
     84 I AT]"" D
     85 .S PSJL="" D SETTMP
     86 .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"))
     87 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)_")"
     88 D SETTMP
     89 S VALMCNT=PSJLN-1
     90 K PSGSMN,Q,Y,Y1,Y2,PSGLRN
     91 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
     92TEST ;
     93 I $G(PSGPFLG) S VALMSG="INVALID ORDERABLE ITEM"
     94 I $G(PSGDI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" DISPENSE DRUG"
     95 I $G(PSGPI) S VALMSG=$S($G(VALMSG)="":"INVALID",1:VALMSG_",")_" PROVIDER"
     96 Q
     97 ;
     98DISPLAY ;
     99 N X,LEN,LIM,PCS
     100 S LIM=$L(PSJWPL," "),PCS=1
     101 F X=1:1:LIM S LEN=$L($P(PSJWPL," ",PCS,X)) D
     102 . I LEN'<72!(X=LIM) D
     103 .. S PSJL=$P(PSJWPL," ",PCS,X)
     104 .. I PCS>1 S PSJL="   "_PSJL
     105 .. S PCS=X+1
     106 .. D SETTMP
     107 Q
     108 ;
     109SETTMP ;
     110 S ^TMP("PSJUDE",$J,PSJLN,0)=PSJL,PSJLN=PSJLN+1,PSJL=""
     111 Q
     112 ;
     113HILITE(FLD) ;
     114 N COL,LAB,LIN,WID,X
     115 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))
     116 I FLD=7 S LIN=+$G(PSJLN)-1 Q:LIN<13
     117 D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)
     118 Q
     119 ;
     1201 ;;1,5,16,PSGPDN
     1212 ;;3,5,16,PSGDO
     1223 ;;4,58,7,PSGSDN
     1234 ;;5,10,11,PSGMRN
     1245 ;;6,59,6,PSGFDN
     1256 ;;7,6,15,PSGSTN
     1267 ;;18,5,14,PSGSMN
     1278 ;;8,11,12,PSGSCH
     1289 ;;9,8,13,PSGAT
     12910 ;;10,11,10,PSGPRN
     13011 ;;11,7,22,PSGSI
     131ENKILL ;
     132 K PSGAT,PSGDO,PSGEB,PSGEFN,PSGFD,PSGFDN,PSGHSM,PSGNEFD,PSGNESD,PSGOEEF,PSGOEER,PSGOFD,PSGOHSM,PSGOMR,PSGMRN,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGOSD
     133 K PSGOSM,PSGOST,PSGPD,PSGPDN,PSGPR,PSGSD,PSGSM,PSGOINST,PSGPRN,PSGRFDN,PSGRSDN,PSGSCH,PSGSDN,PSGSI,PSGSTN,PSJWPL,RNDT
     134 Q
Note: See TracChangeset for help on using the changeset viewer.