| [623] | 1 | PSGOEF ;BIR/CML3-FINISH ORDERS ENTERED THROUGH OE/RR ;14 May 98 / 2:17 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**7,30,29,35,39,47,50,56,80,116,110,111,133,153**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA 2191
|
|---|
| 5 | ; Reference to ^PSDRUG( is supported by DBIA 2192
|
|---|
| 6 | ; Reference to DOSE^PSSORPH is supported by DBIA 3234.
|
|---|
| 7 | ;
|
|---|
| 8 | START ;
|
|---|
| 9 | I '$D(^PS(53.1,+PSGORD)) W $C(7),!?3,"Cannot find this pending order (#",+PSGORD,")." Q
|
|---|
| 10 | D NOW^%DTC S PSGDT=+$E(%,1,12) K PSGFDX,PSGEFN,PSGOEEF,PSGOES,PSGONF,PSGRDTX S PSGOES=1,(PSGOEF,PSGOEEF)=0,PSGOEEG=3
|
|---|
| 11 | I $D(PSJTUD) S PSGDO=$P($G(^PS(53.1,+PSGORD,.3)),U),(PSGPDRG,PSGPD)=PSJCOI,(PSGPDRGN,PSGPDN)=$$OINAME^PSJLMUTL(PSGPD)
|
|---|
| 12 | I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S X=PSGSCH D EN^PSGORS0 S:$D(X) PSGAT=PSGS0Y D
|
|---|
| 13 | . NEW PSJDOX,PSJDOSE,PSJPIECE,PSJUNIT,PSJX,X
|
|---|
| 14 | . S X=$G(^PS(53.1,+PSGORD,1,1,0)) Q:'+X
|
|---|
| 15 | . D DOSE^PSSORPH(.PSJDOX,+X,"U")
|
|---|
| 16 | . I $S('$D(PSJDOX):1,1:+PSJDOX(1)=-1) Q
|
|---|
| 17 | . S PSJPIECE=$S($P(PSJDOX(1),U)="":3,1:1)
|
|---|
| 18 | . S X=^PS(53.1,+PSGORD,.2)
|
|---|
| 19 | . S:PSJPIECE=3 PSJDOSE=$P(X,U,2)
|
|---|
| 20 | . S:PSJPIECE=1 PSJDOSE=$P(X,U,5),PSJUNIT=$P(X,U,6)
|
|---|
| 21 | . F X=0:0 S X=$O(PSJDOX(X)) Q:+$G(PSJX)!'X D
|
|---|
| 22 | .. I PSJPIECE=3,($P(PSJDOX(X),U,3)'=PSJDOSE) Q
|
|---|
| 23 | .. I PSJPIECE=1,($P(PSJDOX(X),U,1)_$P(PSJDOX(X),U,2)'=(PSJDOSE_PSJUNIT)) Q
|
|---|
| 24 | .. S:+$P(PSJDOX(X),U,12) $P(^PS(53.45,PSJSYSP,2,1,0),U,2)=+$P(PSJDOX(X),U,12),PSJX=1
|
|---|
| 25 | I PSGEB'=PSGOPR F X=7,11 S Y=$T(@(3_X)),@("PSGEFN("_X_")="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))="",PSGOEEF=PSGOEEF+1
|
|---|
| 26 | D GTST^PSGOE6(+PSGORD)
|
|---|
| 27 | I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S PSGSD="" D:PSGS0Y]""
|
|---|
| 28 | .N PSJX S PSJX=$P($G(^PS(53.1,+PSGORD,0)),U,25) I PSJX="" Q
|
|---|
| 29 | .I PSJX["U" S PSGSD=$P($G(^PS(55,DFN,5,+PSJX,2)),U,2) Q
|
|---|
| 30 | .I PSJX["V" S PSGSD=$P($G(^PS(55,DFN,"IV",+PSJX,0)),U,2) Q
|
|---|
| 31 | .I PSJX["P" S PSGSD=$P($G(^PS(53.1,+PSJX,2)),U,2)
|
|---|
| 32 | S:PSGSD="" PSGSD=PSGLI
|
|---|
| 33 | S PSGNEDFD=$$GTNEDFD^PSGOE7("U",+PSGPD)
|
|---|
| 34 | S:$P($G(PSGNEDFD),U,3)="" $P(PSGNEDFD,U,3)=PSGST ; N PSGOEA S PSGOEA="R"
|
|---|
| 35 | S (PSGNESD,PSGSD)=$$ENSD^PSGNE3(PSGSCH,PSGS0Y,PSGLI,PSGSD)
|
|---|
| 36 | ;if this is a renewal order, ignore any 'requested start date' received. Use the system calculated start date.
|
|---|
| 37 | I $P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" D
|
|---|
| 38 | . D REQDT^PSJLIVMD(PSGORD)
|
|---|
| 39 | E D
|
|---|
| 40 | . S X=$$DSTART^PSJDCU(DFN,$P(^PS(53.1,+PSGORD,0),U,25)) I X]"" S (PSGNESD,PSGSD)=X K PSGRSD
|
|---|
| 41 | D ; Extend the Default Stop Date if needed for the first renewed order.
|
|---|
| 42 | .N PSGOEAO,PSGWALLO
|
|---|
| 43 | .I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S PSGOEAO=PSGOEA,PSGOEA="R",PSGWALLO=$P(^PS(55,DFN,5.1),U)
|
|---|
| 44 | .D ENFD^PSGNE3(PSGLI) S PSGFD=$S($G(PSGRDTX(+PSGORD,"PSGFD")):PSGRDTX(+PSGORD,"PSGFD"),1:PSGNEFD)
|
|---|
| 45 | .I $P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S PSGOEA=PSGOEAO,$P(^PS(55,DFN,5.1),U)=PSGWALLO
|
|---|
| 46 | N DUR,PSGRNSD S PSGRNSD=+$$LASTREN^PSJLMPRI(DFN,PSGORD) I PSGRNSD S DUR=$$GETDUR^PSJLIVMD(DFN,PSGORD,"P",1) I DUR]"" D
|
|---|
| 47 | . N DURMIN S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN S PSGFD=$$FMADD^XLFDT(PSGRNSD,,,DURMIN)
|
|---|
| 48 | S PSGOFD="",PSGSDN=$$ENDD^PSGMI(PSGSD)_U_$$ENDTC^PSGMI(PSGSD),PSGFDN=$$ENDD^PSGMI(PSGFD)_U_$$ENDTC^PSGMI(PSGFD)
|
|---|
| 49 | S PSGLIN=$$ENDD^PSGMI(PSGLI)_U_$$ENDTC^PSGMI(PSGLI)
|
|---|
| 50 | I '$O(^PS(53.45,PSJSYSP,2,0)) N DRG,DRGCNT S DRGCNT=0 D
|
|---|
| 51 | .F X=0:0 S X=$O(^PSDRUG("ASP",+PSGPD,X)) Q:'X!(DRGCNT>1) S:$P($G(^PSDRUG(+X,2)),U,3)["U" DRGCNT=DRGCNT+1,DRG=+X
|
|---|
| 52 | .I DRGCNT=1 K ^PS(53.45,PSJSYSP,2) S ^PS(53.45,PSJSYSP,2,1,0)=DRG_U_1,^PS(53.45,PSJSYSP,2,0)="^53.4502^1^1",PS(53.45,PSJSYSP,2,"B",+DRG,1)=""
|
|---|
| 53 | Q
|
|---|
| 54 | FINISH ;
|
|---|
| 55 | ; force display of second screen if CPRS order checks exist
|
|---|
| 56 | N NSFF,PSGOEF39 S NSFF=1 K PSJNSS
|
|---|
| 57 | I $G(PSGORD),$D(PSGRDTX(+PSGORD)) D K PSGRDTX
|
|---|
| 58 | . S:$G(PSGRDTX(+PSGORD,"PSGRSD")) PSGSD=PSGRDTX(+PSGORD,"PSGRSD")
|
|---|
| 59 | . S:$G(PSGRDTX(+PSGORD,"PSGRFD")) PSGFD=$S($G(PSGRDTX(+PSGORD,"PSGRFD")):PSGRDTX(+PSGORD,"PSGRFD"),1:$G(PSGNEFD))
|
|---|
| 60 | N PSJCOM S PSJCOM=+$P($G(^PS(53.1,+PSGORD,.2)),"^",8)
|
|---|
| 61 | I $O(^PS(53.1,+PSGORD,12,0))!$O(^PS(53.1,+PSGORD,10,0)) D
|
|---|
| 62 | .Q:$G(PSJLMX)=1 ; there's no second screen to display
|
|---|
| 63 | .S VALMBG=16 D RE^VALM4,PAUSE^VALM1
|
|---|
| 64 | D FULL^VALM1
|
|---|
| 65 | I $G(PSJPROT)=3,'$D(PSJTUD),'$$ENIVUD^PSGOEF1(PSGORD) Q
|
|---|
| 66 | S CHK=0 S:$P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" PSGSI=$$ENPC^PSJUTL("U",+PSJSYSP,180,PSGSI)
|
|---|
| 67 | I $G(PSGOSCH)]"" D S:$G(PSGS0XT)'<0 $P(^PS(53.1,+PSGORD,2),"^",6)=PSGS0XT
|
|---|
| 68 | .N PSGOES,PSGS0Y,PSGSCH S X=PSGOSCH K:$G(PSJTUD) NSFF D ENOS^PSGS0 I '($G(PSGORD)["P"&($P($G(^PS(53.1,+PSGORD,0)),"^",24)="R")) I $G(X)]""&$G(PSGS0Y) S PSGAT=PSGS0Y
|
|---|
| 69 | .I $G(PSJNSS) S PSGOSCH="" K PSJNSS
|
|---|
| 70 | I '$G(PSJTUD),$G(PSJNSS),($G(PSGOSCH)]"") D NSSCONT^PSGS0(PSGOSCH,PSGS0XT) K PSJNSS S PSGOSCH=""
|
|---|
| 71 | S PSGOEFF=PSGOSCH=""+('$O(^PS(53.45,PSJSYSP,2,0))*10)
|
|---|
| 72 | I PSGOEFF S X=$S(PSGOEFF#2:" a SCHEDULE",1:"")_$S(PSGOEFF=11:" and",1:"")_$S(PSGOEFF>9:" at least one DISPENSE DRUG",1:"")
|
|---|
| 73 | I 'PSGOEFF I (($G(PSGS0XT)="D")&($G(PSGAT)="")) S X=" Admin Times",PSGOEFF=1,PSGOEF39=1
|
|---|
| 74 | I PSGOEFF,X]"" S X=X_" before it can be finished."
|
|---|
| 75 | I PSGOEFF S CHK=1 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," "
|
|---|
| 76 | I $G(PSGOEF39) S PSGOEE=0,PSGOEFF=0 D I 'PSGOEE D REFRESH^VALM G DONE
|
|---|
| 77 | .S F1=53.1,MSG=0,Y=$T(39),@("PSGFN(39)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEEF,PSGOEE)=1 W ! D @$P($T(39),";",3) S CHK=0
|
|---|
| 78 | I PSGOEFF=1 S F1=53.1,MSG=0,Y=$T(38),@("PSGFN(38)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(38),";",3) S CHK=0 G:'PSGOEE DONE
|
|---|
| 79 | I PSGOEFF=11 S F1=53.1,MSG=0,Y=$T(32),@("PSGFN(32)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(32),";",3) D G:'PSGOEE DONE
|
|---|
| 80 | .S F1=53.1,MSG=0,Y=$T(38),@("PSGFN(38)="_$P(Y,";",7)),PSGOEEF(+$P(Y,";",3))=1,(PSGOEE,PSGOEEF)=1 W ! D @$P($T(38),";",3) S CHK=0
|
|---|
| 81 | I PSGOEFF>9 S CHK=7 D ENDRG^PSGOEF1(+PSGPD,0) I CHK D ABORTACC Q
|
|---|
| 82 | I 'PSGOEFF D OC531^PSGOESF ; check every dispense drug from CPRS
|
|---|
| 83 | S VALMBG=1
|
|---|
| 84 | I 'PSGOEFF&($D(PSGORQF)) D RE^VALM4 Q
|
|---|
| 85 | I $G(MSG) K DIR S DIR(0)="E" W !! D ^DIR
|
|---|
| 86 | I PSGOEFF D:PSGST="" GTST^PSGOE6(+PSGORD)
|
|---|
| 87 | S PSJLMFIN=1
|
|---|
| 88 | K PSJACEPT I $O(^PS(53.1,+PSGORD,12,0)) S PSJLMP2=1
|
|---|
| 89 | S PSGOEENO=0,PSGSTAT=$S($P(PSJSYSP0,U,9):"ACTIVE",1:"NON-VERIFIED")
|
|---|
| 90 | NEW PSJDOSE,PSJDOX,PSJDSFLG
|
|---|
| 91 | D DOSECHK^PSJDOSE
|
|---|
| 92 | S:+$G(PSJDSFLG) VALMSG="Dosage Ordered & Dispense Drug are not compatible"
|
|---|
| 93 | I PSGODO=PSGDO S PSGOEEF(109)=""
|
|---|
| 94 | I PSGODO'=PSGDO S PSGOEENO=1,VALMSG="This change will cause a new order to be created "
|
|---|
| 95 | D EN^VALM("PSJU LM ACCEPT")
|
|---|
| 96 | I $G(PSJNSS) D S PSGOEEF(26)="" K PSJACEPT,PSJNSS
|
|---|
| 97 | .K DIR S DIR(0)="FOA",DIR("A")="Invalid Schedule" D ^DIR K DIR
|
|---|
| 98 | I $G(PSGS0XT)="D",'$G(PSGS0Y),'$G(PSGAT),((",P,R,")'[(","_$G(PSGST)_",")) D S PSGOEEF(39)="" K PSJACEPT
|
|---|
| 99 | .K DIR S DIR(0)="FOA",DIR("A")=" WARNING - Admin times are required for DAY OF WEEK schedules " D ^DIR K DIR
|
|---|
| 100 | I '$G(PSJACEPT) D ABORTACC Q
|
|---|
| 101 | I $G(PSJRNF),$G(^PS(53.1,+PSGORD,4)) D
|
|---|
| 102 | . W $C(7),!!,"ACCEPTING THIS ORDER WILL CHANGE THE STATUS TO ACTIVE."
|
|---|
| 103 | . S DIR(0)="Y",DIR("A")="Do you wish to make this order Active",DIR("?",1)="Enter ""N"" if you wish to exit without Activating this order,"
|
|---|
| 104 | . S DIR("?")="or ""Y"" to continue with the Activation process." D ^DIR S:'Y Y=-1 K DIR
|
|---|
| 105 | I $G(PSJRNF),$G(Y)=-1 S PSJACEPT=0 D ABORTACC Q
|
|---|
| 106 | I $G(PSJRNF),$G(Y)=1 S PSGOEAV=1
|
|---|
| 107 | I PSGOEENO S PSJNOO=$$ENNOO^PSJUTL5("E"),PSJACEPT=$S(PSJNOO<0:0,1:1)
|
|---|
| 108 | ACCEPT ;
|
|---|
| 109 | S VALMBCK=$S($G(PSJACEPT):"Q",1:"R")
|
|---|
| 110 | I '$G(PSJACEPT) D ABORTACC Q
|
|---|
| 111 | K PSGOES,PSGRSD,PSGRSDN D:PSGOEENO NEW3^PSGOEE D:'PSGOEENO UPD^PSGOEF1 I $D(PSGOEF)!PSGOEENO S PSGCANFL=-1
|
|---|
| 112 | D DONE1^PSGOEE
|
|---|
| 113 | D DONE
|
|---|
| 114 | Q
|
|---|
| 115 | BYPASS ;
|
|---|
| 116 | S PSGCANFL=1
|
|---|
| 117 | ;
|
|---|
| 118 | DONE ;
|
|---|
| 119 | K CHK,DA,DIE,DR,DRG,MSG,Q1,Q2 ;PSGND,PSGOEE,PSGOEEF,PSGOEEND,PSGOEEG,PSGOEF,PSGOEFF,PSGOES,PSGOPD,PSGOPDN,PSGOPR,PSGOSCH,PSGPDRG,PSGDRGN,PSG0XT,PSGS0Y,OSGSD,Q1,Q2
|
|---|
| 120 | Q
|
|---|
| 121 | ABORTACC ; Abort Accept process.
|
|---|
| 122 | D ABORT^PSGOEE K PSGOEEF D GETUD^PSJLMGUD(PSGP,PSGORD),^PSGOEF,ENSFE^PSGOEE0(PSGP,PSGORD),INIT^PSJLMUDE(PSGP,PSGORD) S VALMBCK="R",PSGSD=PSGNESD,PSGFD=PSGNEFD Q
|
|---|
| 123 | ;
|
|---|
| 124 | ;
|
|---|
| 125 | 31 ;;101^PSGOE8;PSGOPD;PSGPD;101;1
|
|---|
| 126 | 32 ;;109^PSGOE8;PSGODO;PSGDO;109;PSGODO]""
|
|---|
| 127 | 33 ;;10^PSGOE81;PSGOSD;PSGSD;10;0
|
|---|
| 128 | 34 ;;3^PSGOE8;PSGOMR;PSGMR;3;1
|
|---|
| 129 | 35 ;;25^PSGOE81;PSGOFD;PSGFD;25;0
|
|---|
| 130 | 36 ;;7^PSGOE8;PSGOST;PSGST;7;0
|
|---|
| 131 | 37 ;;5^PSGOE82;PSGOSM;PSGSM;5;0
|
|---|
| 132 | 38 ;;26^PSGOE8;PSGOSCH;PSGSCH;26;1
|
|---|
| 133 | 39 ;;39^PSGOE81;PSGOAT;PSGAT;39;0
|
|---|
| 134 | 310 ;;1^PSGOE82;PSGOPR;PSGPR;1;1
|
|---|
| 135 | 311 ;;8^PSGOE81;PSGOSI;PSGSI;8;0
|
|---|
| 136 | 312 ;;2^PSGOE82;;;2;0
|
|---|
| 137 | 313 ;;40^PSGOE82;;;40;0
|
|---|
| 138 | ;
|
|---|
| 139 | AH ;
|
|---|
| 140 | 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."
|
|---|
| 141 | Q
|
|---|
