- PSJLMUDE ;BIR/MLM - SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;Jun 16, 2021@14:42:04
- ;;5.0;INPATIENT MEDICATIONS;**7,47,50,63,64,58,80,116,110,111,164,175,201,181,254,267,228,315,317,338,373,327,319,415,399**;16 DEC 97;Build 64
- ;
- ;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
- ; Reference to $$GET^XPAR is supported by DBIA #2263
- ;
- INIT(PSGP,PSGORD) ;
- N D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR,J K ^TMP("PSJUDE",$J),^TMP($J,"GMRAING")
- 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)
- . I $$OVRCHK^PSGSICH1(PSGP,PSGORD) S PSJVD="<OCI>"_PSJVD
- . S PSJL=$$SETSTR^VALM1(PSJVD,PSJL,(80-$L(PSJVD)),80)
- . D:PSJVD]"" CNTRL^VALM10(1,80-$L(PSJVD),$L(PSJVD),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,52,28) D:$G(PSGOEEF(10)) HILITE(3) ;#373
- 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=$$ENDTC2^PSGMI(+OSTRT) ;#373
- . S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(3)):$E(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start: "_OSTRTN,PSJL,52,28) ;#373
- 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=$$ENDTC2^PSGMI(+PSGRNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32) ;#373
- I '$G(PSGRNDT),$G(PSGRDTX) D
- . I $D(PSGRDTX)<10 S PSGRSDN=$$ENDTC2^PSGMI(+PSGRDTX),PSJL=$$SETSTR^VALM1("REQUESTED START: "_PSGRSDN,PSJL,46,34) Q ;#373
- . I $G(PSGRDTX(+$G(PSJORD),"PSGRSD")),$P($G(PSGSDN),U,2) S PSGRSDN=$$ENDTC2^PSGMI(PSGRDTX(+PSJORD,"PSGRSD")),PSJL=$$SETSTR^VALM1("Calc Start: "_PSGRSDN,PSJL,51,34) D ;#373
- .. 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=$$ENDTC2^PSGMI(+RNDT),PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,34) ;#373
- D SETTMP
- I PSGORD]"" S PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)
- I $G(PSJBCMA)]"" S PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
- ; START NCC REMEDIATION >> 327*RJS
- S PSJL=$$SETSTR^VALM1($S($D(PSGEFN(5)):$E(" *",PSGEFN(5)+1)_"(5)",1:" ")_" Stop: "_$P(PSGFDN,U,2),PSJL,52,28) D SETTMP D:$G(PSGOEEF(25))!($G(PSGOEEF(34))) HILITE(5) ;#373
- 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=$$ENDTC2^PSGMI(PSGRDTX(+PSJORD,"PSGRFD")),PSJL=$$SETSTR^VALM1("Calc Stop: "_PSGRFDN,PSJL,52,28) D ;#373
- . I PSGFD'=PSGRDTX(+PSJORD,"PSGRFD") D CNTRL^VALM10(7,54,80,IORVON,IORVOFF)
- ;; END NCC REMEDIATION >> 327*RJS
- 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(PSGNOHI)&($G(PSGOEEF(39))!($G(PSGOEEF(41)))) HILITE(9) ;*315
- I +$G(PSGRF)>1 N PSGRMVD S PSGRMVD=$S(+$G(PSGRMVT):PSGRMVT,1:"") S PSJL=$$SETSTR^VALM1("Removal Times: "_PSGRMVD,PSJL,6,71) D SETTMP ;*315
- 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=$S($D(PSGEFN(11)):$E(" *",PSGEFN(11))_" (11)",1:" ")_" Special Instructions"_$S($P(PSGSI,"^",2)=1:"!: ",1:": ") D
- .I '$D(^PS(53.45,DUZ,5,1)),$G(PSGORD) D GETSI^PSJBCMA5(PSGP,PSGORD)
- .I '$P($G(^PS(53.45,DUZ,5,0)),"^",3) S PSJL=PSJL_$P($G(PSGSI),"^") D PTXT^PSJLMPRU(PSJL,"PSJUDE",1,80) Q
- .S PSJL=PSJL_" (see below)" D SETTMP N I S I=0 F J=1:1 S I=$O(^PS(53.45,DUZ,5,I)) Q:'I S PSJL=" "_^PS(53.45,DUZ,5,I,0) D SETTMP
- S PSJL=" (14) Indication: "_$G(PSGIND) D SETTMP ;*399-IND
- 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
- N PSJPPQ S PSJPPQ="" ;p415
- S PSJL=$S($D(PSGEFN(12)):$E(" *",PSGEFN(12))_" (12)",1:" ")_" Dispense Drug",PSJL=$$SETSTR^VALM1("U/D",PSJL,52,60),PSJL=$$SETSTR^VALM1("Inactive Date",PSJL,59,16) D D SETTMP,CNTRL^VALM10(PSJLN-1,1,80,IOUON,IOUOFF,0)
- .I $$GET^XPAR("SYS","PSJ PADE OE BALANCES") D
- ..I '$G(VAIN(4)) N VAIN,DFN S DFN=$G(PSGP) D INP^VADPT
- ..N PSJORCL,PSJCLNK
- ..; If clinic order, quit if clinic location is not linked to PADE
- ..S PSJORCL=$S($G(PSGORD)["P":$G(^PS(53.1,+$G(PSGORD),"DSS")),$G(PSGORD)["U":$G(^PS(55,+$G(PSGP),5,+$G(PSGORD),8)),$G(PSGORD)["V":$G(^PS(55,+$G(PSGP),"IV",+$G(PSGORD),"DSS")),1:"")
- ..S:'PSJORCL PSJORCL=$G(PSJCLAPP) ;p415
- ..I PSJORCL,$P(PSJORCL,"^",2) S PSJCLNK=$$PADECL^PSJPAD50(+$G(PSJORCL)) Q:'PSJCLNK
- ..I '$G(PSJCLNK) Q:'$$PADEWD^PSJPAD50(+$G(VAIN(4))) ; PADE device Inactive?
- ..S PSJL=$$SETSTR^VALM1("PADE",PSJL,75,5)
- ..S PSJPPQ=1 ;p415
- NEW PSJX,PSJDLINE
- 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,52,63) S:PSGID PSJL=$$SETSTR^VALM1(PSGID,PSJL,59,16) D D SETTMP
- ..; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is YES, PADE balances should display as identifier.
- ..I $$GET^XPAR("SYS","PSJ PADE OE BALANCES") D
- ...N PSJPDLOC,VAIN,PSJORCL,PSJCLNK,PSJCLND D INP^VADPT
- ...; If clinic order, quit if clinic location is not linked to PADE
- ...S PSJCLND=$S($G(PSGORD)["P":$G(^PS(53.1,+$G(PSGORD),"DSS")),$G(PSGORD)["U":$G(^PS(55,+$G(PSGP),5,+$G(PSGORD),8)),$G(PSGORD)["V":$G(^PS(55,+$G(PSGP),"IV",+$G(PSGORD),"DSS")),1:"")
- ...S PSJORCL=$S(+PSJCLND&$P(PSJCLND,"^",2):+PSJCLND,1:"")
- ...I 'PSJCLND,PSJPPQ S PSJORCL=$G(PSJCLAPP),PSJCLND=PSJORCL ;p415 added to print PADE qty in profile
- ...I PSJORCL,$P(PSJCLND,"^",2) S PSJCLNK=$$PADECL^PSJPAD50(+$G(PSJORCL)) Q:'PSJCLNK
- ...I '$G(PSJCLNK) Q:'$$PADEWD^PSJPAD50(+$G(VAIN(4))) ; Quit if patient location not linked to PADE
- ...S PSJPDLOC=$S($G(PSJCLNK):PSJORCL_"C",1:"")
- ...S:'PSJPDLOC PSJPDLOC=+$G(VAIN(4))
- ...N PADE S PADE=$J($$DRGQTY^PSJPADSI(+ND,$S(PSJPDLOC["C":"CL",1:"WD"),+PSJPDLOC),5)
- ...S PSJL=$$SETSTR^VALM1(PADE,PSJL,74,5)
- ..S PSJX=$G(PSJX)+1
- ..S PSJDLINE=$S($P(^PS(53.45,PSJSYSP,2,0),U,3)>1:16,1:13) ;*228 - Highlight multiple dispense drugs
- ..I $G(PSGOEEF(109)) D CNTRL^VALM10(PSJDLINE+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
- ; If clinic order, get clinic location and appointment date ;p319
- N PSJCLND
- S PSJCLND=$S(+$G(PSJCLAPP):PSJCLAPP,$G(PSGORD)["P":$G(^PS(53.1,+$G(PSGORD),"DSS")),$G(PSGORD)["U":$G(^PS(55,+$G(PSGP),5,+$G(PSGORD),8)),$G(PSGORD)["V":$G(^PS(55,+$G(PSGP),"IV",+$G(PSGORD),"DSS")),1:"")
- I +PSJCLND S PSJL="(15)"_" Visit Location: "_$P($G(^SC(+PSJCLND,0)),U) D SETTMP
- I $P(PSJCLND,"^",2)'="" S PSJL="(16)"_" Visit Date: "_$$ENDTC2^PSGMI($P(PSJCLND,"^",2)) 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="CPRS 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="" D SETTMP
- ..D FORMATTX($G(^PS(53.1,+PSGORD,10,Q,0)))
- ..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"
- I $G(PSGDREQ) S CHK=1,VALMSG="DOSAGE IS REQUIRED" K PSGDREQ
- Q
- DISPLAY ;
- S PSJL=PSJWPL D SETTMP
- Q
- ;
- SETTMP ;
- S ^TMP("PSJUDE",$J,PSJLN,0)=PSJL,PSJLN=PSJLN+1,PSJL=""
- Q
- ;
- HILITE(FLD) ;
- N COL,LIN,WID,X
- ; PSJ*5*319 FLD 3 st. pos. now 56 and width 9 in $Text area
- ; PSJ*5*319 FLD 5 st. pos. now 57 and width 8 in $Text area
- 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))
- I $G(PSGRF),FLD>9 S LIN=LIN+1 ;COMPENSATE FOR REMOVAL TIMES
- I FLD=7 S LIN=+$G(PSJLN)-1 Q:LIN<13
- D CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)
- Q
- ;
- FORMATTX(PSJX) ;
- NEW PSJX1,Y,Y1
- S PSJX1=""
- F Y=1:1:$L(PSJX," ") S Y1=$P(PSJX," ",Y) D
- . I ($L(PSJX1)+$L(Y1)+1)>79 S:$E(PSJX1,1,1)=" " PSJX1=$E(PSJX1,2,$L(PSJX1)) S PSJL=PSJX1,PSJX1="" D SETTMP
- . S PSJX1=PSJX1_Y1_" "
- I PSJX1]"" S PSJL=PSJX1 D SETTMP
- K PSJX1
- Q
- ;
- 1 ;;1,5,16,PSGPDN
- 2 ;;3,5,16,PSGDO
- 3 ;;4,56,9,PSGSDN
- 4 ;;5,10,11,PSGMRN
- 5 ;;6,57,8,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 ;
- ; 373 - Additionally, KILL off PSJALLGY
- K PSGNOHI,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,PSJALLGY,PSGIND,PSGOIND,PSGOEE Q ;*399-IND
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJLMUDE 12563 printed Jan 18, 2025@03:08:45 Page 2
- PSJLMUDE ;BIR/MLM - SHOW FIELDS FOR EDIT (LISTMAN STYLE) ;Jun 16, 2021@14:42:04
- +1 ;;5.0;INPATIENT MEDICATIONS;**7,47,50,63,64,58,80,116,110,111,164,175,201,181,254,267,228,315,317,338,373,327,319,415,399**;16 DEC 97;Build 64
- +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 ; Reference to $$GET^XPAR is supported by DBIA #2263
- +9 ;
- INIT(PSGP,PSGORD) ;
- +1 NEW D,ND,PSJBCMA,PSJL,PSJLM,PSJLN,Q,QQ,PSJDUR,J
- KILL ^TMP("PSJUDE",$JOB),^TMP($JOB,"GMRAING")
- +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 IF $$OVRCHK^PSGSICH1(PSGP,PSGORD)
- SET PSJVD="<OCI>"_PSJVD
- +8 SET PSJL=$$SETSTR^VALM1(PSJVD,PSJL,(80-$LENGTH(PSJVD)),80)
- +9 if PSJVD]""
- DO CNTRL^VALM10(1,80-$LENGTH(PSJVD),$LENGTH(PSJVD),IORVON,IORVOFF,0)
- End DoDot:1
- DO SETTMP
- if $GET(PSGOEEF(108))!($GET(PSGOEEF(101)))
- DO HILITE(1)
- +10 IF $GET(PSJORD)["P"
- DO REQDT^PSJLIVMD(PSJORD)
- +11 SET PSJL="Instructions: "_PSGOINST
- DO PTXT^PSJLMPRU(PSJL,"PSJUDE",6,80)
- +12 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)
- +13 IF $GET(PSGRDTX)
- SET PSJDUR=$$FMTDUR^PSJLIVMD($PIECE($GET(PSGRDTX),U,2))
- +14 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)
- +15 SET PSJL=$$SETSTR^VALM1("Duration: "_$GET(PSJDUR),PSJL,11,25)
- +16 ;#373
- SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(3)):$EXTRACT(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start: "_$PIECE(PSGSDN,U,2),PSJL,52,28)
- if $GET(PSGOEEF(10))
- DO HILITE(3)
- +17 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
- +18 ;#373
- NEW OSTRT,OSTRTN
- SET OSTRT=$GET(@("^PS(55,"_PSGP_",5,"_+OLDO_",2)"))
- SET OSTRT=$PIECE(OSTRT,"^",2)
- if 'OSTRT
- QUIT
- SET OSTRTN=$$ENDTC2^PSGMI(+OSTRT)
- +19 ;#373
- SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(3)):$EXTRACT(" *",PSGEFN(3)+1)_"(3)",1:" ")_"Start: "_OSTRTN,PSJL,52,28)
- End DoDot:1
- +20 DO SETTMP
- +21 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)
- +22 ;#373
- IF $GET(PSJORD)["P"
- NEW PSGRNDT
- SET PSGRNDT=$$LASTREN^PSJLMPRI(DFN,PSGORD)
- if PSGRNDT
- SET PSGRNDT=$$ENDTC2^PSGMI(+PSGRNDT)
- SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,32)
- +23 IF '$GET(PSGRNDT)
- IF $GET(PSGRDTX)
- Begin DoDot:1
- +24 ;#373
- IF $DATA(PSGRDTX)<10
- SET PSGRSDN=$$ENDTC2^PSGMI(+PSGRDTX)
- SET PSJL=$$SETSTR^VALM1("REQUESTED START: "_PSGRSDN,PSJL,46,34)
- QUIT
- +25 ;#373
- IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRSD"))
- IF $PIECE($GET(PSGSDN),U,2)
- SET PSGRSDN=$$ENDTC2^PSGMI(PSGRDTX(+PSJORD,"PSGRSD"))
- SET PSJL=$$SETSTR^VALM1("Calc Start: "_PSGRSDN,PSJL,51,34)
- Begin DoDot:2
- +26 IF PSGSD'=PSGRDTX(+PSJORD,"PSGRSD")
- DO CNTRL^VALM10(5,53,80,IORVON,IORVOFF)
- End DoDot:2
- End DoDot:1
- +27 ; Indirect reference in PSGOEEWF below refers to either ^PS(53.1 or ^PS(55,DFN,5,. Naked reference refers to full indirect reference
- +28 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
- +29 ;#373
- NEW PSGRNDT
- SET PSGRNDT=$$ENDTC2^PSGMI(+RNDT)
- SET PSJL=$$SETSTR^VALM1("Renewed: "_PSGRNDT,PSJL,54,34)
- End DoDot:1
- +30 DO SETTMP
- +31 IF PSGORD]""
- SET PSJBCMA=$$BCMALG^PSJUTL2(PSGP,PSGORD)
- +32 IF $GET(PSJBCMA)]""
- SET PSJL=$$SETSTR^VALM1(PSJBCMA,PSJL,1,52)
- +33 ; START NCC REMEDIATION >> 327*RJS
- +34 ;#373
- SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(5)):$EXTRACT(" *",PSGEFN(5)+1)_"(5)",1:" ")_" Stop: "_$PIECE(PSGFDN,U,2),PSJL,52,28)
- DO SETTMP
- if $GET(PSGOEEF(25))!($GET(PSGOEEF(34)))
- DO HILITE(5)
- +35 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)
- +36 ;#373
- IF $GET(PSJORD)["P"
- IF $GET(PSGRDTX(+$GET(PSJORD),"PSGRFD"))
- IF $PIECE($GET(PSGFDN),U,2)
- SET PSGRFDN=$$ENDTC2^PSGMI(PSGRDTX(+PSJORD,"PSGRFD"))
- SET PSJL=$$SETSTR^VALM1("Calc Stop: "_PSGRFDN,PSJL,52,28)
- Begin DoDot:1
- +37 IF PSGFD'=PSGRDTX(+PSJORD,"PSGRFD")
- DO CNTRL^VALM10(7,54,80,IORVON,IORVOFF)
- End DoDot:1
- +38 ;; END NCC REMEDIATION >> 327*RJS
- +39 DO SETTMP
- +40 SET PSGSMN=$PIECE("NO^YES",U,PSGSM+1)
- +41 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)
- +42 ;*315
- 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(PSGNOHI)&($GET(PSGOEEF(39))!($GET(PSGOEEF(41))))
- DO HILITE(9)
- +43 ;*315
- IF +$GET(PSGRF)>1
- NEW PSGRMVD
- SET PSGRMVD=$SELECT(+$GET(PSGRMVT):PSGRMVT,1:"")
- SET PSJL=$$SETSTR^VALM1("Removal Times: "_PSGRMVD,PSJL,6,71)
- DO SETTMP
- +44 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
- +45 SET PSJL=$SELECT($DATA(PSGEFN(11)):$EXTRACT(" *",PSGEFN(11))_" (11)",1:" ")_" Special Instructions"_$SELECT($PIECE(PSGSI,"^",2)=1:"!: ",1:": ")
- Begin DoDot:1
- +46 IF '$DATA(^PS(53.45,DUZ,5,1))
- IF $GET(PSGORD)
- DO GETSI^PSJBCMA5(PSGP,PSGORD)
- +47 IF '$PIECE($GET(^PS(53.45,DUZ,5,0)),"^",3)
- SET PSJL=PSJL_$PIECE($GET(PSGSI),"^")
- DO PTXT^PSJLMPRU(PSJL,"PSJUDE",1,80)
- QUIT
- +48 SET PSJL=PSJL_" (see below)"
- DO SETTMP
- NEW I
- SET I=0
- FOR J=1:1
- SET I=$ORDER(^PS(53.45,DUZ,5,I))
- if 'I
- QUIT
- SET PSJL=" "_^PS(53.45,DUZ,5,I,0)
- DO SETTMP
- End DoDot:1
- +49 ;*399-IND
- SET PSJL=" (14) Indication: "_$GET(PSGIND)
- DO SETTMP
- +50 SET PSJL=""
- DO SETTMP
- if $GET(PSGOEEF(8))
- DO HILITE(11)
- +51 ; E3R 16130
- +52 IF $ORDER(^PS(53.45,PSJSYSP,2,1))
- FOR
- SET PSJL=""
- DO SETTMP
- if PSJLN>15
- QUIT
- +53 ;p415
- NEW PSJPPQ
- SET PSJPPQ=""
- +54 SET PSJL=$SELECT($DATA(PSGEFN(12)):$EXTRACT(" *",PSGEFN(12))_" (12)",1:" ")_" Dispense Drug"
- SET PSJL=$$SETSTR^VALM1("U/D",PSJL,52,60)
- SET PSJL=$$SETSTR^VALM1("Inactive Date",PSJL,59,16)
- Begin DoDot:1
- +55 IF $$GET^XPAR("SYS","PSJ PADE OE BALANCES")
- Begin DoDot:2
- +56 IF '$GET(VAIN(4))
- NEW VAIN,DFN
- SET DFN=$GET(PSGP)
- DO INP^VADPT
- +57 NEW PSJORCL,PSJCLNK
- +58 ; If clinic order, quit if clinic location is not linked to PADE
- +59 SET PSJORCL=$SELECT($GET(PSGORD)["P":$GET(^PS(53.1,+$GET(PSGORD),"DSS")),$GET(PSGORD)["U":$GET(^PS(55,+$GET(PSGP),5,+$GET(PSGORD),8)),$GET(PSGORD)["V":$GET(^PS(55,+$GET(PSGP),"IV",+$GET(PSGORD),"DSS")),1:"")
- +60 ;p415
- if 'PSJORCL
- SET PSJORCL=$GET(PSJCLAPP)
- +61 IF PSJORCL
- IF $PIECE(PSJORCL,"^",2)
- SET PSJCLNK=$$PADECL^PSJPAD50(+$GET(PSJORCL))
- if 'PSJCLNK
- QUIT
- +62 ; PADE device Inactive?
- IF '$GET(PSJCLNK)
- if '$$PADEWD^PSJPAD50(+$GET(VAIN(4)))
- QUIT
- +63 SET PSJL=$$SETSTR^VALM1("PADE",PSJL,75,5)
- +64 ;p415
- SET PSJPPQ=1
- End DoDot:2
- End DoDot:1
- DO SETTMP
- DO CNTRL^VALM10(PSJLN-1,1,80,IOUON,IOUOFF,0)
- +65 NEW PSJX,PSJDLINE
- +66 FOR Q=0:0
- SET Q=$ORDER(^PS(53.45,PSJSYSP,2,Q))
- if 'Q
- QUIT
- SET ND=$GET(^(Q,0))
- Begin DoDot:1
- +67 SET D=$PIECE(ND,"^")
- SET PSGID=$PIECE(ND,"^",3)
- IF PSGID
- SET PSGID=$$ENDTC^PSGMI(PSGID)
- +68 SET D=$SELECT(D="":"NOT FOUND",'$DATA(^PSDRUG(D,0)):D,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:D_";PSDRUG(")
- +69 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,52,63)
- if PSGID
- SET PSJL=$$SETSTR^VALM1(PSGID,PSJL,59,16)
- Begin DoDot:2
- +70 ; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is YES, PADE balances should display as identifier.
- +71 IF $$GET^XPAR("SYS","PSJ PADE OE BALANCES")
- Begin DoDot:3
- +72 NEW PSJPDLOC,VAIN,PSJORCL,PSJCLNK,PSJCLND
- DO INP^VADPT
- +73 ; If clinic order, quit if clinic location is not linked to PADE
- +74 SET PSJCLND=$SELECT($GET(PSGORD)["P":$GET(^PS(53.1,+$GET(PSGORD),"DSS")),$GET(PSGORD)["U":$GET(^PS(55,+$GET(PSGP),5,+$GET(PSGORD),8)),$GET(PSGORD)["V":$GET(^PS(55,+$GET(PSGP),"IV",+$GET(PSGORD),"DSS")),1:"")
- +75 SET PSJORCL=$SELECT(+PSJCLND&$PIECE(PSJCLND,"^",2):+PSJCLND,1:"")
- +76 ;p415 added to print PADE qty in profile
- IF 'PSJCLND
- IF PSJPPQ
- SET PSJORCL=$GET(PSJCLAPP)
- SET PSJCLND=PSJORCL
- +77 IF PSJORCL
- IF $PIECE(PSJCLND,"^",2)
- SET PSJCLNK=$$PADECL^PSJPAD50(+$GET(PSJORCL))
- if 'PSJCLNK
- QUIT
- +78 ; Quit if patient location not linked to PADE
- IF '$GET(PSJCLNK)
- if '$$PADEWD^PSJPAD50(+$GET(VAIN(4)))
- QUIT
- +79 SET PSJPDLOC=$SELECT($GET(PSJCLNK):PSJORCL_"C",1:"")
- +80 if 'PSJPDLOC
- SET PSJPDLOC=+$GET(VAIN(4))
- +81 NEW PADE
- SET PADE=$JUSTIFY($$DRGQTY^PSJPADSI(+ND,$SELECT(PSJPDLOC["C":"CL",1:"WD"),+PSJPDLOC),5)
- +82 SET PSJL=$$SETSTR^VALM1(PADE,PSJL,74,5)
- End DoDot:3
- +83 SET PSJX=$GET(PSJX)+1
- +84 ;*228 - Highlight multiple dispense drugs
- SET PSJDLINE=$SELECT($PIECE(^PS(53.45,PSJSYSP,2,0),U,3)>1:16,1:13)
- +85 IF $GET(PSGOEEF(109))
- DO CNTRL^VALM10(PSJDLINE+PSJX,7,73,IORVON_IOBON,IORVOFF_IOBOFF,0)
- End DoDot:2
- DO SETTMP
- End DoDot:1
- +86 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
- +87 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
- +88 DO SETTMP
- SET PSJL=$$SETSTR^VALM1($SELECT($DATA(PSGEFN(7)):$EXTRACT(" *",PSGEFN(7)+1)_"(7)",1:" ")_"Self Med: "_PSGSMN,PSJL,1,24)
- +89 if PSGSM&PSGHSM
- SET PSJL=$$SETSTR^VALM1(" (HS)",PSJL,16,7)
- DO SETTMP
- if $GET(PSGOEEF(5))
- DO HILITE(7)
- +90 DO SETTMP
- SET PSJL="Entry By: "_PSGEBN
- SET PSJL=$$SETSTR^VALM1("Entry Date: "_$PIECE(PSGLIN,U,2),PSJL,51,39)
- DO SETTMP
- +91 IF $GET(PSGLRN)
- DO SETTMP
- SET PSJL="Renewed By: "_$$ENNPN^PSGMI($PIECE(PSGLRN,"^",2))
- DO SETTMP
- +92 DO SETTMP
- SET PSJL="(13)"_" Comments:"
- +93 if '$ORDER(^PS(53.45,PSJSYSP,1,0))
- DO SETTMP
- +94 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
- +95 DO SETTMP
- +96 ; If clinic order, get clinic location and appointment date ;p319
- +97 NEW PSJCLND
- +98 SET PSJCLND=$SELECT(+$GET(PSJCLAPP):PSJCLAPP,$GET(PSGORD)["P":$GET(^PS(53.1,+$GET(PSGORD),"DSS")),$GET(PSGORD)["U":$GET(^PS(55,+$GET(PSGP),5,+$GET(PSGORD),8)),$GET(PSGORD)["V":$GET(^PS(55,+$GET(PSGP),"IV",+$GET(PSGORD),"DSS")),1:"")
- +99 IF +PSJCLND
- SET PSJL="(15)"_" Visit Location: "_$PIECE($GET(^SC(+PSJCLND,0)),U)
- DO SETTMP
- +100 IF $PIECE(PSJCLND,"^",2)'=""
- SET PSJL="(16)"_" Visit Date: "_$$ENDTC2^PSGMI($PIECE(PSJCLND,"^",2))
- DO SETTMP
- +101 ;
- +102 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
- +103 DO SETTMP
- SET PSJL="CPRS Order Checks:"
- DO SETTMP
- +104 FOR Q=0:0
- SET Q=$ORDER(^PS(53.1,+PSGORD,10,Q))
- if 'Q
- QUIT
- Begin DoDot:2
- +105 ;S PSJL="" D SETTMP S PSJL=$G(^PS(53.1,+PSGORD,10,Q,0)) D SETTMP
- +106 SET PSJL=""
- DO SETTMP
- +107 DO FORMATTX($GET(^PS(53.1,+PSGORD,10,Q,0)))
- +108 SET PSJL="Overriding Provider: "_$PIECE($GET(^PS(53.1,+PSGORD,10,Q,1)),U)
- DO SETTMP
- +109 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
- +110 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)
- SET VALMBG=16
- KILL PSJLMP2
- TEST ;
- +1 IF $GET(PSGPFLG)
- SET VALMSG="INVALID ORDERABLE ITEM"
- +2 IF $GET(PSGDI)
- SET VALMSG=$SELECT($GET(VALMSG)="":"INVALID",1:VALMSG_",")_" DISPENSE DRUG"
- +3 IF $GET(PSGPI)
- SET VALMSG=$SELECT($GET(VALMSG)="":"INVALID",1:VALMSG_",")_" PROVIDER"
- +4 IF $GET(PSGDREQ)
- SET CHK=1
- SET VALMSG="DOSAGE IS REQUIRED"
- KILL PSGDREQ
- +5 QUIT
- DISPLAY ;
- +1 SET PSJL=PSJWPL
- DO SETTMP
- +2 QUIT
- +3 ;
- SETTMP ;
- +1 SET ^TMP("PSJUDE",$JOB,PSJLN,0)=PSJL
- SET PSJLN=PSJLN+1
- SET PSJL=""
- +2 QUIT
- +3 ;
- HILITE(FLD) ;
- +1 NEW COL,LIN,WID,X
- +2 ; PSJ*5*319 FLD 3 st. pos. now 56 and width 9 in $Text area
- +3 ; PSJ*5*319 FLD 5 st. pos. now 57 and width 8 in $Text area
- +4 SET X="$T("_FLD_"^PSJLMUDE)"
- SET @("X="_X)
- SET X=$PIECE(X,";;",2)
- SET LIN=+X
- SET COL=$PIECE(X,",",2)
- SET LAB=$PIECE(X,",",3)
- SET X=$PIECE(X,",",4)
- SET WID=(LAB+$LENGTH(@X))
- +5 ;COMPENSATE FOR REMOVAL TIMES
- IF $GET(PSGRF)
- IF FLD>9
- SET LIN=LIN+1
- +6 IF FLD=7
- SET LIN=+$GET(PSJLN)-1
- if LIN<13
- QUIT
- +7 DO CNTRL^VALM10(LIN,COL,WID,IORVON_IOBON,IORVOFF_IOBOFF,0)
- +8 QUIT
- +9 ;
- FORMATTX(PSJX) ;
- +1 NEW PSJX1,Y,Y1
- +2 SET PSJX1=""
- +3 FOR Y=1:1:$LENGTH(PSJX," ")
- SET Y1=$PIECE(PSJX," ",Y)
- Begin DoDot:1
- +4 IF ($LENGTH(PSJX1)+$LENGTH(Y1)+1)>79
- if $EXTRACT(PSJX1,1,1)=" "
- SET PSJX1=$EXTRACT(PSJX1,2,$LENGTH(PSJX1))
- SET PSJL=PSJX1
- SET PSJX1=""
- DO SETTMP
- +5 SET PSJX1=PSJX1_Y1_" "
- End DoDot:1
- +6 IF PSJX1]""
- SET PSJL=PSJX1
- DO SETTMP
- +7 KILL PSJX1
- +8 QUIT
- +9 ;
- 1 ;;1,5,16,PSGPDN
- 2 ;;3,5,16,PSGDO
- 3 ;;4,56,9,PSGSDN
- 4 ;;5,10,11,PSGMRN
- 5 ;;6,57,8,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 ;
- +1 ; 373 - Additionally, KILL off PSJALLGY
- +2 ;*399-IND
- KILL PSGNOHI,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,PSJALLGY,PSGIND,PSGOIND,PSGOEE
- QUIT