source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLMGUD.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1PSJLMGUD ;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 ;
9GETUD(DFN,PSGORD) ;
10 ;
11EN2 ;
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 ;
31SET ;
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 ;
44FINISH ;
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 ;
54ACCEPT ;
55 D UPD^PSGOEF1 G DONE
56BYPASS ;
57 S PSGCANFL=1 G DONE
58 ;
59EDIT ;
60 S PSGPDRG=PSGOPD,PSGPDRGN=PSGOPDN K PSGOEEND D ENF^PSGOEE I PSGCANFL=-1 D UPD^PSGOEF1
61 ;
62DONE ;
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 ;
6731 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
6832 ;;109^PSGOE8;PSGODO;PSGDO;102;PSGODO]""
6933 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
7034 ;;7^PSGOE8;PSGOST;PSGST;7;0
7135 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1
7236 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
7337 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
7438 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
7539 ;;2^PSGOE82;;;2;0
76310 ;;40^PSGOE82;;;40;0
77311 ;;66^PSGOE82;;;66;1
78312 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
79313 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
80314 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
81 ;
82AH ;
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
Note: See TracBrowser for help on using the repository browser.