1 | PSJLMGUD ;BIR/MLM-INITIALIZE UNIT DOSE ORDER FIELDS FOR DISPLAY ;05 Feb 99 / 9:46 AM
|
---|
2 | ;;5.0; INPATIENT MEDICATIONS ;**25,58,85,116,110,111**;16 DEC 97
|
---|
3 | ;
|
---|
4 | ; Reference to ^PS(51.2 is supported by DBIA 2178
|
---|
5 | ; Reference to ^PSDRUG( is supported by DBIA 2192
|
---|
6 | ; Reference to ^PS(55 is supported by DBIA 2191
|
---|
7 | ; Reference to ES^ORX8 is supported by DBIA 3632
|
---|
8 | ;
|
---|
9 | GETUD(DFN,PSGORD) ;
|
---|
10 | ;
|
---|
11 | EN2 ;
|
---|
12 | N %X,%Y,ND2,DO,DRGI,FD,FL,FQC,NF,ND,PRI,SD,SIG,ST,STD,X,Y,ESIG
|
---|
13 | K GMRAL,P
|
---|
14 | S NF=$S(PSGORD["U":0,PSGORD["A":0,PSGORD["O":0,1:1) I NF,$D(^PS(53.1,+PSGORD,0)),$P(^(0),"^",19),$D(^PS(55,DFN,5,$P(^(0),"^",19))),(+$P(^(0),"^",19)'=+$P(^(0),"^",25)) S PSGORD=+$P(^PS(53.1,+PSGORD,0),"^",19)_"U",NF=0
|
---|
15 | S (FL,Y)="",$P(FL,"-",71)="",PSGOEEWF="^PS("_$S(NF:"53.1,",1:"55,"_DFN_",5,")_+PSGORD_","
|
---|
16 | ; The naked reference on the line below refers to the full reference created by indirect reference to F, where F may refer to ^PS(53.1 or the IV or UD multiple ^PS(55
|
---|
17 | S ND=$G(@(PSGOEEWF_"0)")),ND2=$G(^(2)),PSGEB=$P($G(^(4)),"^",7),PSGOSI=$G(^(6)),SIG=$G(^(6.5)),DO=$G(^(.2)),PSGOINST=$G(^(.3)),ESIG=$P(DO,U,3),PSG14=$P($G(^(14,0)),"^",3)
|
---|
18 | I PSG14 S PSGLRN=$G(@(PSGOEEWF_"14,"_PSG14_",0)"))
|
---|
19 | S PSGOPD=+DO,PSGODO=$P(DO,U,2),PSGOPDN=$$OINAME^PSJLMUTL(+DO),X=$P(DO,U,4),PSGPRIO=$P("STAT^ASAP^ROUTINE^PREOP^TIME CRITICAL^DONE",U,$F("SARPTD",X)-1),PSJPRI=X
|
---|
20 | S PSGOPR=$P(ND,"^",2),PSGOMR=$P(ND,"^",3),PSGOSM=$P(ND,"^",5),PSGOHSM=$P(ND,"^",6),(PSGOST,ST)=$P(ND,"^",7),STT=$P(ND,"^",9),PSGOMRN=$S('PSGOMR:"",1:$P($G(^PS(51.2,PSGOMR,0)),"^")) S:PSGOMRN="" PSGOMRN=PSGOMR
|
---|
21 | S PSGLI=$P(ND,U,16),PSGOSCH=$P(ND2,"^"),(PSGOSD,SD)=$P(ND2,"^",2),(FD,PSGOFD)=$P(ND2,"^",4),(FQC,PSGS0XT)=$P(ND2,"^",6),(PSGOAT,PSGS0Y)=$P(ND2,"^",5)
|
---|
22 | S PSGLIN=$$ENDD^PSGMI(PSGLI)_U_$$ENDTC^PSGMI(PSGLI)
|
---|
23 | ;I FQC="D",PSGOAT="" S PSGOAT=$E($P(SD,".",2)_"0000",1,4)
|
---|
24 | S PRI=$S('PSGOPR:0,1:$P($G(^VA(200,PSGOPR,"PS")),"^",4)),DRGI=$S(PSGOPD'=+PSGOPD:0,1:+$G(^PSDRUG(+PSGOPD,"I"))) S:PRI PRI=DT'<PRI S:DRGI DRGI=DT'<DRGI
|
---|
25 | S PSGOPRN=$S('PSGOPR:"",1:$P($G(^VA(200,PSGOPR,0)),"^")) S:PSGOPRN="" PSGOPRN=PSGOPR I PSGOSI]"" S PSGOSI=$$ENSET^PSGSICHK(PSGOSI)
|
---|
26 | I $L($T(ES^ORX8)) N ESIG1 S ESIG1=$$ES^ORX8(+$P(ND,U,21)_";1") S:ESIG1=1 ESIG="ES"
|
---|
27 | S PSGOPRN=PSGOPRN_$S(ESIG]"":" ["_$$LOW^XLFSTR(ESIG)_"]",1:"")
|
---|
28 | S PSGEBN=$$ENNPN^PSGMI(PSGEB) S:$P(ND,U,27)="R" STT="R"
|
---|
29 | S X=STT,PSGSTAT=$S(X="":"NOT FOUND",X="DE":"DISCONTINUED (EDIT)",X="DR":"DISCONTINUED (RENEWAL)",X="RE":"REINSTATED",1:$P(X_"^ACTIVE^DISCONTINUED^EXPIRED^HOLD^INCOMPLETE^NON-VERIFIED^PENDING^RENEWED^UNRELEASED","^",$F("ADEHINPRU",X)))
|
---|
30 | ;
|
---|
31 | SET ;
|
---|
32 | I STT="P" S (FD,SD,ST)=""
|
---|
33 | S PSGOSTN=$$ENSTN^PSGMI(ST),(PSGOFDN,PSGOSDN)="" I SD S PSGOSDN=$$ENDD^PSGMI(SD)_"^"_$$ENDTC^PSGMI(SD)
|
---|
34 | I FD S PSGOFDN=$$ENDD^PSGMI(FD)_"^"_$$ENDTC^PSGMI(FD)
|
---|
35 | F X="PD","PDN","MR","MRN","ST","STN","SCH","SI","SD","SDN","FD","FDN","SM","HSM","PR","PRN","DO","AT" S @("PSG"_X)=@("PSGO"_X)
|
---|
36 | K ^PS(53.45,PSJSYSP,1),^(2) S %X=PSGOEEWF_"3,",%Y="^PS(53.45,"_PSJSYSP_",1," D %XY^%RCR S %X=PSGOEEWF_"1,",%Y="^PS(53.45,"_PSJSYSP_",2," D %XY^%RCR
|
---|
37 | S $P(^PS(53.45,PSJSYSP,2,0),"^",2)="53.4502P"
|
---|
38 | K PSJNSS I $G(PSGSCH)'="" D K PSJNSS
|
---|
39 | . ;N PSGS0XT,PSGOES,Y S X=PSGSCH N PSGSCH S PSGSCH="" S:($G(VALMBCK)]"")!'$G(NSFF)!$G(PSJTUD) PSGOES=1 D ENOS^PSGS0
|
---|
40 | . N PSGS0XTO,Y,PSGOES S X=PSGSCH S PSGS0XTO=PSGS0XT N PSGOSCH S PSGOSCH=PSGSCH S PSGSCH="",PSGOES=1
|
---|
41 | . D ENOS^PSGS0 S:$G(X)="" PSGS0XT=PSGS0XTO S PSGSCH=$S($G(X)]""&($G(PSGS0XT)="D"):X,1:PSGOSCH)
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | FINISH ;
|
---|
45 | I '$G(PSGS0XT),PSGOSCH]"" D S $P(^PS(53.1,+PSGORD,2),"^",6)=PSGS0XT
|
---|
46 | .N PSGOES,PSGS0Y S X=PSGOSCH,PSGOES=1 D ENOS^PSGS0
|
---|
47 | S PSGOEFF=PSGOSCH=""+('$O(^PS(53.45,PSJSYSP,2,0))*10) I PSGOEFF S X=$S(PSGOEFF#2:" a SCHEDULE",1:"")_$S(PSGOEFF=11:" and",1:"")_$S(PSGOEFF>9:" at least one DISPENSE DRUG",1:"")_" before it can be finished."
|
---|
48 | I PSGOEFF W $C(7),!!,"PLEASE NOTE: This order must have" F Q=1:1:$L(X," ") S Y=$P(X," ",Q) W:$L(Y)+$X>78 ! W Y," "
|
---|
49 | I PSGOEFF#2 S F1=53.1,MSG=0,Y=$T(35),@("PSGFN(35)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(35),";",3) G:'PSGOEE DONE
|
---|
50 | I PSGOEFF>9 S CHK=7 D ENDRG^PSGOEF1(PSGOPD,0) G:CHK DONE
|
---|
51 | I $G(MSG) K DIR S DIR(0)="E" W !! D ^DIR
|
---|
52 | I PSGOEFF D:PSGST="" GTST^PSGOE6(+PSGORD) N XQORM D EN^VALM("PSJ LM OE DISPLAY") G DONE ;D ENW^PSGOEEW
|
---|
53 | ;
|
---|
54 | ACCEPT ;
|
---|
55 | D UPD^PSGOEF1 G DONE
|
---|
56 | BYPASS ;
|
---|
57 | S PSGCANFL=1 G DONE
|
---|
58 | ;
|
---|
59 | EDIT ;
|
---|
60 | S PSGPDRG=PSGOPD,PSGPDRGN=PSGOPDN K PSGOEEND D ENF^PSGOEE I PSGCANFL=-1 D UPD^PSGOEF1
|
---|
61 | ;
|
---|
62 | DONE ;
|
---|
63 | K CHK,DA,DIE,DR,DRG,MSG,ORETURN,ORIFN,PSGEB,PSGEFN,PSGND,PSGOEE,PSGOEEF,PSGOEEND,PSGOEEG,PSGOEF,PSGOEFF,PSGOES,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGPDRG,PSGDRGN,PSG0XT,PSGS0Y,OSGSD,Q1,Q2
|
---|
64 | Q
|
---|
65 | ;
|
---|
66 | ;
|
---|
67 | 31 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
|
---|
68 | 32 ;;109^PSGOE8;PSGODO;PSGDO;102;PSGODO]""
|
---|
69 | 33 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
|
---|
70 | 34 ;;7^PSGOE8;PSGOST;PSGST;7;0
|
---|
71 | 35 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1
|
---|
72 | 36 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
|
---|
73 | 37 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
|
---|
74 | 38 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
|
---|
75 | 39 ;;2^PSGOE82;;;2;0
|
---|
76 | 310 ;;40^PSGOE82;;;40;0
|
---|
77 | 311 ;;66^PSGOE82;;;66;1
|
---|
78 | 312 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
|
---|
79 | 313 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
|
---|
80 | 314 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
|
---|
81 | ;
|
---|
82 | AH ;
|
---|
83 | W !!?2,"Answer 'YES' to accept this order as a NON-VERIFIED UNIT DOSE order. Answer",!,"'NO' to edit this order now. Enter '^' to BYPASS this order, leaving it as",!,"a PENDING INPATIENT order."
|
---|
84 | Q
|
---|