| 1 | PSGOEE ;BIR/CML3-EDIT ACTIVE OR NON-VERIFIED ORDERS ;01 May 98 / 8:44 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**4,7,29,47,64,58,82,91,110,111,112,142**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA# 2191.
|
|---|
| 5 | ; Reference to ^PSSLOCK is supported by DBIA# 2789.
|
|---|
| 6 | ;
|
|---|
| 7 | D NOW^%DTC S PSGDT=% K PSGEFN,PSGOEEF S PSGOEEF=0 I PSGORD["A"!(PSGORD["O") G ACT
|
|---|
| 8 | 531 ; edit orders in 53.1
|
|---|
| 9 | ENF ;
|
|---|
| 10 | D EN2^PSGOEEW
|
|---|
| 11 | K PSJACEPT D EDLOOP G:'$G(PSJACEPT) OUT
|
|---|
| 12 | I $G(PSGOEENO) D
|
|---|
| 13 | . N PSGOEENO S PSGOEENO=1 D NEW
|
|---|
| 14 | E D
|
|---|
| 15 | . N PSGOEENO S PSGOEENO=0 D UPD
|
|---|
| 16 | I $G(PSGOEAV) D ACT1 Q
|
|---|
| 17 | D DONE1
|
|---|
| 18 | S PSGOEEF=0,PSJORD=PSGORD D GETUD^PSJLMGUD(PSGP,PSGORD),ENSFE^PSGOEE0(PSGP,PSGORD)
|
|---|
| 19 | Q
|
|---|
| 20 | ACT ;
|
|---|
| 21 | D EN2^PSGOEEW,EDLOOP G:'$G(PSJACEPT) OUT
|
|---|
| 22 | I $G(PSGOEENO) D
|
|---|
| 23 | . N PSGOEENO S PSGOEENO=1 D NEW
|
|---|
| 24 | E D
|
|---|
| 25 | . N PSGOEENO S PSGOEENO=0 D UPD
|
|---|
| 26 | S:$D(PSGOEF)!$G(PSGOEENO) PSGCANFL=-1
|
|---|
| 27 | ACT1 ;I 'PSGOEAV,PSJSYSL>1 S $P(@($S(PSGORD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,")_+PSGORD_",7)"),"^",1,2)=PSGDT_"^"_$E("D",PSGOEENO)_"E",PSGTOL=2,PSGUOW=DUZ,PSGTOO=PSGORD'["U"+1,DA=+PSGORD D ENL^PSGVDS
|
|---|
| 28 | D DONE1
|
|---|
| 29 | S PSGOEEF=0 D GETUD^PSJLMGUD(PSGP,PSGORD),ENSFE^PSGOEE0(PSGP,PSGORD) D:PSGOEAV UNL^PSSLOCK(PSGP,PSGORD)
|
|---|
| 30 | Q
|
|---|
| 31 | EDIT ;
|
|---|
| 32 | D FULL^VALM1
|
|---|
| 33 | W ! S PSGOEER="" F Q=1:1 S Q1=$P(Y,",",Q) Q:'Q1 S X=$P($T(@(PSGOEEG_Q1)),";",3),PSGOEER=PSGOEER_X_";",PSGOEEF(+X)=Q
|
|---|
| 34 | S LIMIT=$L(PSGOEER,";")-1,(PSGDEF,PSGOEE)=0 F S PSGOEE=PSGOEE+1 Q:PSGOEE>LIMIT I +$P(PSGOEER,";",PSGOEE)=101 S PSGDEF=1
|
|---|
| 35 | S PSGOEER=$E(PSGOEER,1,$L(PSGOEER)-1),(MSG,PSGOEE)=0 F S PSGOEE=PSGOEE+1 Q:PSGOEE>$L(PSGOEER,";") S F1=$S(PSGOEEG=3:53.1,1:55.06) I 'PSGDEF!((PSGDEF)&(+$P(PSGOEER,";",PSGOEE)'=2)) D @$P(PSGOEER,";",PSGOEE) Q:'PSGOEE
|
|---|
| 36 | Q
|
|---|
| 37 | EDLOOP ; Continue prompting for fields to edit.
|
|---|
| 38 | D:$G(Y) EDIT
|
|---|
| 39 | D ENNOU^PSGOEE0 I '$G(PSGOEENO),DR="" S VALMBCK="R" Q
|
|---|
| 40 | K VALMSG
|
|---|
| 41 | I '$G(PSGOEENO),$G(PSGPDNX) D CKDT
|
|---|
| 42 | I $G(PSGOEENO) D
|
|---|
| 43 | .S VALMSG="This change will cause a new order to be created." D GTSTATUS,CHKDD,CKDT
|
|---|
| 44 | .S PSGEBN=$$ENNPN^PSGMI(DUZ),PSGLIN=$$ENDD^PSGMI(PSGDT)_U_$$ENDTC^PSGMI(PSGDT)
|
|---|
| 45 | D CHK^PSGOEV("^^"_PSGMR_"^^^^"_PSGST,PSGPDRG_U_PSGDO,PSGSCH_U_PSGSD_"^^"_PSGFD)
|
|---|
| 46 | K VALMBCK,PSJACEPT,PSGPDNX D EN^VALM("PSJU LM ACCEPT") Q:'$G(PSJACEPT)
|
|---|
| 47 | I $G(PSGS0XT)="D",'$G(PSGS0Y) I ((",P,R,")'[(","_$G(PSGST)_",")) D Q
|
|---|
| 48 | .S PSJACEPT=0 W !!,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D PAUSE^VALM1
|
|---|
| 49 | I $G(PSGOEENO) S PSJNOO=$$ENNOO^PSJUTL5("E")
|
|---|
| 50 | D K1 S PSJACEPT=$S($G(PSJNOO)<0:0,1:1)
|
|---|
| 51 | S VALMBCK=$S('PSJACEPT:"R",'PSGOEAV:"R",1:"Q")
|
|---|
| 52 | Q
|
|---|
| 53 | CHKDD ;*** Check inactive Dispense drug within the order.
|
|---|
| 54 | D CHKDRG^PSGOE2
|
|---|
| 55 | Q
|
|---|
| 56 | CKDT ; Check if new start/stop dates should be calculated.
|
|---|
| 57 | S PSGS0Y=$S($D(PSGS0Y):PSGS0Y,1:$G(PSGAT))
|
|---|
| 58 | I ('$G(PSGNEWDT)&(PSGSD=$G(PSGOSD))&(PSGFD=$G(PSGOFD)))!($G(PSGOST)'=PSGST)!(PSGSCH'=$G(PSGOSCH))!($G(PSGPDNX)) D
|
|---|
| 59 | .N PSGOES S PSGOES=1,PSGOFD=PSGFD D ^PSGNE3 S PSGSD=PSGNESD,PSGSDN=$$ENDD^PSGMI(PSGNESD)_U_$$ENDTC^PSGMI(PSGNESD),PSGFD=PSGNEFD,PSGFDN=$$ENDD^PSGMI(PSGNEFD)_U_$$ENDTC^PSGMI(PSGNEFD),PSGNEWDT=1
|
|---|
| 60 | .I $D(PSGOFD),PSGOFD]"",PSGFD'=PSGOFD S PSGOEEF(25)=1
|
|---|
| 61 | .I $D(PSGOSD),PSGOSD]"",PSGSD'=PSGOSD S PSGOEEF(10)=1
|
|---|
| 62 | Q
|
|---|
| 63 | NEW3 ;
|
|---|
| 64 | ;S:PSGOEAV PSGOEAV="0^1"
|
|---|
| 65 | NEW ;
|
|---|
| 66 | W !,"...discontinuing original order..."
|
|---|
| 67 | I PSGORD["P" S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8) I PSJCOM D NEW^PSJCOM1 Q
|
|---|
| 68 | ;DC and Unlock order.
|
|---|
| 69 | S PSGEDIT="DE" D ENOR^PSGOECS,UNL^PSSLOCK(PSGP,PSGORD) K PSGEDIT
|
|---|
| 70 | W !!," ...creating new order..." W:'PSGOEAV "(you will now work on this new order)"
|
|---|
| 71 | S PSGS0Y=PSGAT,PSGNESD=PSGSD,PSGNEFD=PSGFD,PSGOEPR=PSGPR,PSGPDRG=PSGPD,PSGPDRGN=PSGPDN,PSGOEE="E"
|
|---|
| 72 | S PSGOORD=PSGORD D ^PSGOETO K PSGOEOS
|
|---|
| 73 | I PSGOORD["U" S $P(^PS(55,PSGP,5,+PSGOORD,0),"^",26,27)=PSGORD_"^E"
|
|---|
| 74 | E S $P(^PS(53.1,+PSGOORD,0),"^",26,27)=PSGORD_"^E"
|
|---|
| 75 | I 'PSGOEAV,($G(PSGORD)["P"),'$G(^PS(53.1,+PSGORD,2.5)),$G(^PS(53.1,+PSGORD,0)) D
|
|---|
| 76 | . N DUR S DUR=$$GETDUR^PSJLIVMD(PSGP,PSGORD,$S(PSGORD["P":"P",1:5),1) I DUR]"" K DA,DR,DIE S DIE="^PS(53.1,",DA=+PSGORD,DR="116////"_DUR D ^DIE
|
|---|
| 77 | I PSGOEAV,+PSJSYSU=3,'$D(PSGOES) D EN^PSGPEN(PSGORD),UNL^PSSLOCK(PSGP,PSGORD) Q
|
|---|
| 78 | S PSJORD=PSGORD,PSGACT=$$ENACTION^PSGOE1(PSGP,PSGORD)
|
|---|
| 79 | Q
|
|---|
| 80 | UPD ;
|
|---|
| 81 | K DA W !!,"...updating order..."
|
|---|
| 82 | I PSGORD["P" S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8) I PSJCOM D UPD^PSJCOM Q
|
|---|
| 83 | ; Set trigger for FIELD (12) Dispense Drug to print a updated pick list.
|
|---|
| 84 | I PSGORD["U",$D(^PS(53.45,PSJSYSP,2,1,0)),$D(^PS(55,PSGP,5,+PSGORD,1,1,0)) D
|
|---|
| 85 | .N PSJX12,PSJF12 S PSJF12=0
|
|---|
| 86 | .F PSJX12=0:1 S PSJX12=$O(^PS(53.45,PSJSYSP,2,PSJX12)) Q:+PSJX12=0 S:$G(^PS(53.45,PSJSYSP,2,PSJX12,0))'=$G(^PS(55,PSGP,5,+PSGORD,1,PSJX12,0)) PSJF12=1
|
|---|
| 87 | .S:PSJF12 ^PS(55,"AUE",PSGP,+PSGORD)=""
|
|---|
| 88 | N TMP,PSGSIF S TMP=PSGOEENO N PSGOEENO S PSGOEENO=TMP
|
|---|
| 89 | N II F II=1:1:$L($G(DR),";") I $E($P($G(DR),";",II),1,7)="122////" S PSGSIF=$P(PSGSI,"^",2),PSGSI=$P(PSGSI,"^") Q
|
|---|
| 90 | I $G(PSJCOM),$G(PSJCOMSI) K PSJCOMSI N PSJCHILD,PSJOEORD S PSJOEORD=0 F S PSJOEORD=$O(^PS(55,"ACX",PSJCOM,PSJOEORD)) Q:'PSJOEORD D
|
|---|
| 91 | . S PSJCHILD=0 F S PSJCHILD=$O(^PS(55,"ACX",PSJCOM,PSJOEORD,PSJCHILD)) Q:'PSJCHILD D
|
|---|
| 92 | .. Q:PSJCHILD=PSGORD N DR,DA,DIE,ORD S DR=$S(PSJCHILD["V":"31////"_$G(P("OPI")),1:"8////"_$G(PSGSI)) S DR=DR_";"_$S(PSJCHILD["V":146,1:122)_"////"_+$G(PSGSIF)
|
|---|
| 93 | .. I $E(DR)'="*" S DA=+PSJCHILD,DIE=$S(PSJCHILD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,") S:DIE["^PS(55," DA(1)=PSGP D ^DIE W "." D EN1^PSJHL2(PSGP,"XX",+PSJCHILD_"U")
|
|---|
| 94 | I $E(DR)'="*" S DA=+PSGORD,DIE=$S(PSGORD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,") S:DIE["^PS(55," DA(1)=PSGP D ^DIE W "."
|
|---|
| 95 | F Q=1,3 K @(PSGOEEWF_Q_")") S %X="^PS(53.45,"_PSJSYSP_","_$S(Q=1:2,1:1)_",",%Y=PSGOEEWF_Q_"," K @(PSGOEEWF_Q_")") D %XY^%RCR W "."
|
|---|
| 96 | S $P(@(PSGOEEWF_"1,0)"),"^",2)=$S(PSGORD["U":55.07,1:53.11)_"P"
|
|---|
| 97 | ; Naked reference on the line below refers to full reference using indirection to either ^PS(55 or ^PS(53.1,
|
|---|
| 98 | S ND=$G(@($S(PSGORD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,")_+PSGORD_",0)")) I $P(ND,"^",21) S ORIFN=$P(ND,"^",21),ND1=$G(^(.2)),ND2=$G(^(2)) W !,"...updating OE/RR..." D EN1^PSJHL2(PSGP,"XX",PSGORD)
|
|---|
| 99 | I $$ENACTION^PSGOE1(PSGP,PSGORD)["V" S VALMBCK="R"
|
|---|
| 100 | I PSJSYSL,PSJSYSL<3 S $P(@($S(PSGORD["U":"^PS(55,"_PSGP_",5,",1:"^PS(53.1,")_+PSGORD_",7)"),"^",1,2)=PSGDT_"^"_$E("D",PSGOEENO)_"E",PSGTOL=2,PSGUOW=DUZ,PSGTOO=PSGORD'["U"+1,DA=+PSGORD D ENL^PSGVDS
|
|---|
| 101 | Q
|
|---|
| 102 | OUT ;
|
|---|
| 103 | D ABORT K PSGNEWDT S PSGCANFL=1 D GETUD^PSJLMGUD(PSGP,PSGORD),ENSFE^PSGOEE0(PSGP,PSGORD),INIT^PSJLMUDE(PSGP,PSGORD)
|
|---|
| 104 | Q
|
|---|
| 105 | DONE ;
|
|---|
| 106 | I PSGORD["P",'$D(PSGOEF),PSGSCH]"",$O(^PS(53.1,+PSGORD,1,0)) D ENF^PSGOEE0
|
|---|
| 107 | DONE1 ;
|
|---|
| 108 | I PSGORD["U" S X=+PSGORD L -^PS(55,PSGP,5,X)
|
|---|
| 109 | E L -^PS(53.1,+PSGORD)
|
|---|
| 110 | K ^PS(53.45,+PSJSYSP,1),^(2)
|
|---|
| 111 | I '$D(PSGOEF) K PSGSD,PSGSCH,PSGST,PSGFD
|
|---|
| 112 | K DA,DIE,DIR,DP,DR,DRG,ND,ND0,ND1,ND2,ORIFN,PSGAL,PSGALEF,PSGAT,PSGOEE,PSGOEEF,PSGOEEG,PSGOEEWF,PSGEFN,PSGTOL,PSGTOO,PSGUOW,XREF,PSGEFN,PSGMR,PSGMRN,PSGOROE1,PSGPD,PSGPDN,PSGSI,PSGPR,PSGSM,PSGHSM,PSGSTN,PSGSDN,PSGFDN,PSGPRN
|
|---|
| 113 | K PSGDO,PSGOEENO Q
|
|---|
| 114 | K1 ;
|
|---|
| 115 | K BACK,F1,F2,PSGF2,MSG,PSGEFN,PSGNEWDT,PSGOEEF,PSGOEEND,PSGOPD,PSGOPDN,PSGOMR,PSGOMRN,PSGOSCH,PSGOSI,PSGOPR,PSGOSM,PSGOHSM,PSGOSD,PSGOFD,PSGOST,PSGOPRN,PSGOSTN,PSGOSDN,PSGOFDN,PSGODO,PSGPDRG,PSGPDRGN,PSGOEER
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | ABORT ; Display no change message and pause.
|
|---|
| 119 | S (PSGDI,PSGDFLG)='$$DDOK^PSGOE2(PSGOEEWF_"1,",+$G(@(PSGOEEWF_".2)")))
|
|---|
| 120 | S PSGPFLG='$$OIOK^PSGOE2(+$G(@(PSGOEEWF_".2)")))
|
|---|
| 121 | W !!,$C(7),"No changes made to this order." D PAUSE^VALM1 K PSGOEEF S PSGOEEF=0
|
|---|
| 122 | Q
|
|---|
| 123 | ;
|
|---|
| 124 | GTSTATUS ; Determine status of new order and set LM title.
|
|---|
| 125 | S PSGSTAT=$S($P($G(PSJSYSP0),U,9):"ACTIVE",1:"NON-VERIFIED")
|
|---|
| 126 | S VALM("TITLE")=PSGSTAT_" UNIT DOSE "_$S(PSGSTAT="PENDING":"("_PSGPRIO_")",1:"")
|
|---|
| 127 | Q
|
|---|
| 128 | FIELDS ;
|
|---|
| 129 | 31 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
|
|---|
| 130 | 32 ;;109^PSGOE8;PSGODO;PSGDO;109;PSGODO]""
|
|---|
| 131 | 33 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
|
|---|
| 132 | 34 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
|
|---|
| 133 | 35 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
|
|---|
| 134 | 36 ;;7^PSGOE8;PSGOST;PSGST;7;0
|
|---|
| 135 | 37 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
|
|---|
| 136 | 38 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1
|
|---|
| 137 | 39 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
|
|---|
| 138 | 310 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
|
|---|
| 139 | 311 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
|
|---|
| 140 | 312 ;;2^PSGOE82;;;2;0
|
|---|
| 141 | 313 ;;40^PSGOE82;;;40;0
|
|---|
| 142 | 51 ;;101^PSGOE9;PSGOPD;PSGPD;101;1
|
|---|
| 143 | 52 ;;109^PSGOE9;PSGODO;PSGDO;109;PSGODO]""
|
|---|
| 144 | 53 ;;10^PSGOE91;PSGOSD;PSGSD;10;1
|
|---|
| 145 | 54 ;;3^PSGOE9;PSGOMR;PSGMR;3;1
|
|---|
| 146 | 55 ;;34^PSGOE91;PSGOFD;PSGFD;34;1
|
|---|
| 147 | 56 ;;7^PSGOE9;PSGOST;PSGST;7;0
|
|---|
| 148 | 57 ;;5^PSGOE92;PSGOSM;PSGSM;5;0
|
|---|
| 149 | 58 ;;26^PSGOE9;PSGOSCH;PSGSCH;26;1
|
|---|
| 150 | 59 ;;41^PSGOE91;PSGOAT;PSGAT;41;0
|
|---|
| 151 | 510 ;;1^PSGOE92;PSGOPR;PSGPR;1;1
|
|---|
| 152 | 511 ;;8^PSGOE91;PSGOSI;PSGSI;8;0
|
|---|
| 153 | 512 ;;2^PSGOE92;;;2;0
|
|---|
| 154 | 513 ;;15^PSGOE92;;;15;0
|
|---|
