| 1 | PSIVORC1 ;BIR/MLM-PROCESS INCOMPLETE IV ORDER - CONT ;13 Jan 98 / 11:36 AM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**1,37,69,110,157**;16 DEC 97
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^DD("DD" is supported by DBIA 10017.
|
---|
| 5 | ; Reference to ^DD( is supported by DBIA 2255.
|
---|
| 6 | ; Reference to ^VA(200 is supported by DBIA 10060.
|
---|
| 7 | ; Reference to ^%DT is supported by DBIA 10003.
|
---|
| 8 | ; Reference to ^%DTC is supported by DBIA 10000.
|
---|
| 9 | ; Reference to ^DID is supported by DBIA 2052.
|
---|
| 10 | ; Reference to ^VALM is supported by DBIA 10118.
|
---|
| 11 | ;
|
---|
| 12 | 53 ; IV Type
|
---|
| 13 | ;*S DONE=0 N DIR S DIR(0)="SNA^A:ADMIXTURE;C:CHEMOTHERAPY;"_$S($E(PSIVAC)'["C":"H:HYPERAL;",1:"")_"P:PIGGYBACK;S:SYRINGE",DIR("A")="IV TYPE: "
|
---|
| 14 | S DONE=0 N DIR S DIR(0)="SNA^A:ADMIXTURE;C:CHEMOTHERAPY;H:HYPERAL;P:PIGGYBACK;S:SYRINGE",DIR("A")="IV TYPE: "
|
---|
| 15 | I $G(P("RES"))'="R" S:P(4)]"" DIR("B")="ADMIXTURE",P(4)=""
|
---|
| 16 | D DIRQ,^DIR S:$D(DTOUT)!(X="^") DONE=1 Q:DONE G:$E(X)="^" 53 S P(4)=Y D:"CS"[P(4) @P(4)
|
---|
| 17 | I PSIVAC'="PN" D ENT^PSIVCAL K %DT S X=P(2),%DT="RTX" D ^%DT S P(2)=+Y D ENSTOP^PSIVCAL K %DT S X=P(3),%DT="RTX" D ^%DT S P(3)=+Y
|
---|
| 18 | OTYP ; Get order type, display type.
|
---|
| 19 | S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3) S:PSIVAC'="CF" P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I")
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | C ; Edit Chemo order
|
---|
| 23 | N DIR S DIR(0)="SA^A:ADMIXTURE;P:PIGGYBACK;S:SYRINGE",DIR("A")="CHEMOTHERAPY TYPE: " D DIRQ,^DIR S:$D(DTOUT)!(X=U) DONE=1 Q:$E(X)="^"!(DONE) S P(23)=Y D:P(23)["S" S
|
---|
| 24 | Q
|
---|
| 25 | ;
|
---|
| 26 | S ; Edit Syringe order
|
---|
| 27 | 56 ; Intermittent Syringe
|
---|
| 28 | N DIR S DIR(0)="Y",DIR("??")="^S F1=53.1,F2=56 D ENHLP^PSIVORC1",DIR("A")="INTERMITTENT SYRINGE" D ^DIR Q:$D(DIRUT) S P(5)=Y
|
---|
| 29 | ;
|
---|
| 30 | 55 ; Syringe Size
|
---|
| 31 | N DA,DIR S DIR(0)="53.1,55" D ^DIR I $D(DTOUT)!$D(DUOUT) S DONE=1 Q
|
---|
| 32 | S P("SYRS")=Y
|
---|
| 33 | Q
|
---|
| 34 | ;
|
---|
| 35 | DIRQ ; Set DIR("?") for IV Type prompt.
|
---|
| 36 | S DIR("?")="Enter a code from the list above.",DIR("??")="^S F1=55.01,F2="_$S(DIR("A")["CHEMO":106,1:.04)_" D ENHLP^PSIVORC1"
|
---|
| 37 | S DIR("?",1)="CHOOSE FROM:",Y=$P(DIR(0),U,2) F X=1:1:5 S DIR("?",X+1)=" "_$P($P(Y,";",X),":")_" "_$P($P(Y,";",X),":",2)
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | CKFLDS ; Find required fields missing data.
|
---|
| 41 | NEW PSIVASX,PSIVASY,FIL,DRGTMP
|
---|
| 42 | S EDIT="" F PSIVASX="AD","SOL" D
|
---|
| 43 | .I '$D(DRG(PSIVASX)) S EDIT=EDIT_U_$S(PSIVASX="AD":57,1:58) Q
|
---|
| 44 | .S DNE=0 F PSIVASY=0:0 S PSIVASY=$O(DRG(PSIVASX,PSIVASY)) Q:'PSIVASY!DNE D
|
---|
| 45 | .. I $P(DRG(PSIVASX,PSIVASY),U,3)="" S EDIT=EDIT_U_$S(PSIVASX="AD":57,1:58),DNE=1
|
---|
| 46 | .. ;S FIL=$S(PSIVASX="AD":"52.6",1:"52.7")
|
---|
| 47 | .. ;S DRGTMP=DRG(PSIVASX,PSIVASY) D ORDERCHK^PSIVEDRG(DFN)
|
---|
| 48 | S:'P("MR") EDIT=EDIT_U_3 F X=8,6,2,3 I P(X)="" S EDIT=EDIT_U_$S(X=8:59,X=6:1,X=2:10,X=3:25,1:"")
|
---|
| 49 | I P("DTYP")=1 S:P(9)="" EDIT=EDIT_U_26 S:P(11)="" EDIT=EDIT_U_39
|
---|
| 50 | S:$E(EDIT,1)=U EDIT=$E(EDIT,2,999)
|
---|
| 51 | Q
|
---|
| 52 | ;
|
---|
| 53 | DONE ; Kill variables and exit
|
---|
| 54 | K ACTION,AD,DFN,DNE,DONE,DONE1,DRG,DRGI,DRGN,DRGT,DRGTN,EDIT,ERR,F1,F2,FIL,HDT,J,LN,LN2,ND,ON,ON1,ON55,ORIFN,P,P16,PC,PDM,PG,PN,PNME,PNOW,PSGLMT,PSGODDD
|
---|
| 55 | K PSGSS,PSGSSH,PSIV,PSIVAC,PSIVAT,PSIVCV,PSIVE,PSIVHD,PSIVLN,PSIVOK,PSIVOLD,PSIVORUT,PSIVREA,PSIVSC1,PSIVSTR,PSIVSTRT,PSIVTYPE,PSIVUP,PSIVX,PSIVX1
|
---|
| 56 | K PSJIVORF,PSJORF,PSJORIFN,PSJORL,PSJORNP,PSJORPF,PSJORSTS,PSJIVOF,PSJNKF,PSJORD,RB,RF,SOL,STOP,TYP,UL80,WD,WDN,WG,^TMP("PSIV",$J) D ENIVKV^PSGSETU
|
---|
| 57 | Q
|
---|
| 58 | ENHLP ; order entry fields' help
|
---|
| 59 | N PSJHP,PSJX,PSJD
|
---|
| 60 | ;
|
---|
| 61 | D FIELD^DID(F1,F2,"","HELP-PROMPT","PSJHP")
|
---|
| 62 | I X="?",$D(PSJHP("HELP-PROMPT")) S F=$G(PSJHP("HELP-PROMPT")) W !?5 F F0=1:1:$L(F," ") S F3=$P(F," ",F0) W:$L(F3)+$X>78 !?5 W F3_" "
|
---|
| 63 | ;I X="?",$D(^DD(F1,F2,3)) S F=^(3) W !?5 F F0=1:1:$L(F," ") S F3=$P(F," ",F0) W:$L(F3)+$X>78 !?5 W F3_" "
|
---|
| 64 | ;
|
---|
| 65 | W:$D(^DD(F1,F2,12)) !,"("_^(12)_")" D FIELD^DID(F1,F2,"","XECUTABLE HELP","PSJX") I $D(PSJX("XECUTABLE HELP")) X PSJX("XECUTABLE HELP")
|
---|
| 66 | ;
|
---|
| 67 | ; new code
|
---|
| 68 | D FIELD^DID(F1,F2,"","DESCRIPTION","PSJD")
|
---|
| 69 | G:$S($G(X)="?":1,1:'$O(PSJD("DESCRIPTION",0))) SC F F=0:0 S F=$O(PSJD("DESCRIPTION",F)) Q:'F I $D(PSJD("DESCRIPTION",F)) W !?2,PSJD("DESCRIPTION",F)
|
---|
| 70 | SC ;
|
---|
| 71 | I F2=5!(F2=6) W !,"CHOOSE FROM:",!?8,0,?16,"NO",!?8,1,?16,"YES" Q
|
---|
| 72 | Q
|
---|
| 73 | COMPLTE ;
|
---|
| 74 | S P16=0,PSIVEXAM=1,(PSIVNOL,PSIVCT)=1 D GTOT^PSIVUTL(P(4)) D ^PSIVCHK I $D(DUOUT) W $C(7),!,"Order Unchanged.",! Q
|
---|
| 75 | G:'$D(PSIVFN1) EDIT1
|
---|
| 76 | I ERR=1 S Y=0 G EDIT1
|
---|
| 77 | D CKORD^PSIVORC2 I PSIVCHG D NOW^%DTC S P("LOG")=$E(%,1,12),P("CLRK")=DUZ_U_$P($G(^VA(200,DUZ,0)),U),P("INS")=""
|
---|
| 78 | W ! D ^PSIVORLB K PSIVEXAM S Y=P(2)
|
---|
| 79 | W !,"Start date: " X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),?30," Stop date: " S Y=P(3) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!
|
---|
| 80 | EDIT ;
|
---|
| 81 | I ERR=1 W !,"Please re-edit this order" K DIR S DIR(0)="E" D ^DIR K DIR W:'Y $C(7),"order unchanged." Q:'Y S Y=0 G EDIT1
|
---|
| 82 | ;PSJ*5*157 EFD FOR IV
|
---|
| 83 | D EFDIV^PSJUTL($G(ZZND))
|
---|
| 84 | W:$G(PSIVCHG) !,"*** This change will cause a new order to be created. ***"
|
---|
| 85 | K DIR S DIR(0)="Y",DIR("A")="Is this O.K.",DIR("B")=$S(ERR:"NO",1:"YES"),DIR("?",1)="Enter ""Y"" to make this an active order (only allowed if no errors were"
|
---|
| 86 | S DIR("?")="found in order), ""N"" to edit the order, or ""^"" to leave order unchanged.",DIR("??")="^S HELP=""EDIT"" D ^PSIVHLP"
|
---|
| 87 | D ^DIR K DIR I $D(DIRUT) K DIRUT W $C(7),"Order unchanged." Q
|
---|
| 88 | ;* Kill Unit dose variables when calling from ^PSJLIFNI.
|
---|
| 89 | I +Y,$G(PSJLIFNI) D
|
---|
| 90 | . K ND,ND4,ND6,NDP2
|
---|
| 91 | . K PSGAT,PSGCANFL,PSGDI,PSGDO,PSGDT,PSGEB,PSGEBN,PSGEFN,PSGFD,PSGFDN
|
---|
| 92 | . K PSGHSM,PSGLI,PSGLIN,PSGLMT,PSGMR,PSGMRN,PSGNEDFD,PSGNEF,PSGNEFD
|
---|
| 93 | . K PSGNESD,PSGOAT,PSGODO,PSGODT,PSGEA,PSGOEAV,PSGOEEF
|
---|
| 94 | . K PSGOEEWF,PSGOEEG,PSGOEF,PSGOENG,PSGOES,PSGOFD,PSGOFDN,PSGOHSM
|
---|
| 95 | . K PSGOINST,PSGOMR,PSGOMRN,PSGONC
|
---|
| 96 | . K PSGOPD,PSOPDN,PSGOPR,PSGOPRN,PSGOSD,PSGOSDN,PSGOSI,PSGOSM
|
---|
| 97 | . K PSGOST,PSGOSTN
|
---|
| 98 | . K PSGPD,PSGPDN,PSGPDRG,PSGDRGN,PSGPFLG,PSGPI,PSGPR,PSGPRIO,PSGPRN
|
---|
| 99 | . K PSGPTMP,PSGRRF,PSG0XT,PSGS0Y,PSGSCH,PSGSD,PSGSDN,PSGSI,PSGSM
|
---|
| 100 | . K PSGST,PSGSTAT,PSGSTN,PSJACNWP,PSJACOK,PSJCOI
|
---|
| 101 | EDIT1 ;
|
---|
| 102 | NEW XFLG,PSIVY S PSIVY=Y
|
---|
| 103 | NEW X S X=^TMP("PSJI",$J,0),VALMBG=$S((X<17):1,1:(X-(X#16)))
|
---|
| 104 | I PSIVY=0!'$G(PSIVFN1) S PSIVFN1=1 D EN^VALM("PSJ LM IV AC/EDIT") Q
|
---|
| 105 | S PSIVCHG=0 D EDCHK^PSIVORC2 K PSIVCHG
|
---|
| 106 | S VALMBCK="Q",PSIVACEP=1
|
---|
| 107 | Q
|
---|