- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVEDT.m
r613 r623 1 PSIVEDT ;BIR/MLM-EDIT IV ORDER ;10 Feb 98 / 3:23 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**4,110,127,133,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^DD(53.1 is supported by DBIA 2256. 5 ; Reference to ^PS(52.7 is supported by DBIA 2173. 6 ; Reference to ^PS(52.6 is supported by DBIA 1231. 7 ; Reference to ^PS(51.2 is supported by DBIA 2178. 8 ; Reference to ^PS(50.7 is supported by DBIA 2180. 9 ; Reference to ^PS(55 is supported by DBIA 2191. 10 ; 11 EDIT ; 12 I $G(DFN)&($G(PSJORD)["V") I $$COMPLEX^PSJOE(DFN,PSJORD) D 13 . N X,Y,PARENT,P2ND S P2ND=$S($G(^PS(55,PSGP,"IV",+PSJORD,.2)):$G(^PS(55,PSGP,"IV",+PSJORD,.2)),1:$G(^PS(55,PSGP,5,+PSJORD,.2))) 14 . S PARENT=$P(P2ND,"^",8) 15 . I PARENT D FULL^VALM1 W !!?5,"This order is part of a complex order. Please review the following ",!?5,"associated orders before changing this order." D CMPLX^PSJCOM1(PSGP,PARENT,PSJORD) 16 S DONE=0 17 F PSIVE=1:1 S:DONE&$E(PSIVAC)="C" OREND=1 Q:PSIVE>$L(EDIT,U)!(DONE) Q:'$L($P(EDIT,U,PSIVE)) D @($P(EDIT,U,PSIVE)) S:$E(PSIVAC,2)="N" PSIVOK=PSIVOK_U_$P(EDIT,U,PSIVE) I $E(X)=U,$L(X)>1 S:PSIVE>1 PSIVE=PSIVE-1 F D FF Q:Y<0 D @Y Q:$E(X)'=U 18 K EDIT,PSIVOK,PSGDI 19 Q 20 ; 21 1 ; Provider. 22 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+$G(ON),0)),"^",24)="R" D Q 23 . W !!?5,"This is Renewal order. Provider may not be edited at this point." D PAUSE^VALM1 24 I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q 25 .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Provider may not be edited at this point." D PAUSE^VALM1 26 S P(6)=$S('$G(^VA(200,+P(6),"PS")):"",'$P(^("PS"),U,4):P(6),$P(^("PS"),U,4)<DT:"",1:P(6)) 27 W !,"PROVIDER: "_$S($P(P(6),U,2)]"":$P(P(6),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(X=""&P(6)) Q 28 I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS^PSIVEDT1 G 1 29 I X]"" K DIC S DIC=200,DIC(0)="EQMZ",DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),U,4):1,$P(^(""PS""),U,4)>DT:1,1:0)" D ^DIC K DIC I Y>0 S P(6)=+Y_U_Y(0,0) Q 30 S F1=53.1,F2=1 D ENHLP^PSIVORC1 W $C(7),!!,"A Provider must be entered.",!! G 1 31 Q 32 ; 33 3 ; Med Route. 34 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q 35 . W !!?5,"Med Route may not be edited at this point." D PAUSE^VALM1 36 I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q 37 .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Med Route may not be edited at this point." D PAUSE^VALM1 38 S P(6)=$S('$G(^VA(200,+P(6),"PS")):"",'$P(^("PS"),U,4):P(6),$P(^("PS"),U,4)<DT:"",1:P(6)) 39 I P("MR")="" D 40 .N AD,SOL,OI,RT,RTCNT 41 .S AD=0 F S AD=$O(DRG("AD",AD)) Q:'AD S OI=$P(DRG("AD",AD),"^",6) I OI S OI(OI)="" 42 .S SOL=0 F S SOL=$O(DRG("SOL",SOL)) Q:'SOL S OI=$P(DRG("SOL",SOL),"^",6) I OI S OI(OI)="" 43 .S OI="" F S OI=$O(OI(OI)) Q:'OI S RT=$P(^PS(50.7,OI,0),"^",6) S:RT="" RT="NONE" S RT(RT)=$P($G(^PS(51.2,+RT,0)),"^",3) 44 .S RT="" F RTCNT=0:1 S RT=$O(RT(RT)) Q:RT="" 45 .Q:RTCNT>1 46 .S RT=$O(RT("")) I RT]"" S P("MR")=RT_"^"_$G(RT(RT)) 47 W !,"MED ROUTE: "_$S($P(P("MR"),U,2)]"":$P(P("MR"),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I X=U!(X=""&P("MR"))!($E(X)=U) Q 48 I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS^PSIVEDT1 G 3 49 I X]"" K DIC S DIC=51.2,DIC(0)="EQMZ",DIC("S")="I $P(^(0),U,4)" D ^DIC K DIC I Y>0 S P("MR")=+Y_U_$P(Y(0),U,3) Q 50 S F1=53.1,F2=3 D ENHLP^PSIVORC1 W $C(7),!!,"A Med Route must be entered." G 3 51 Q 52 ; 53 10 ; Start Date. 54 D 10^PSIVEDT1 55 Q 56 ; 57 25 ; Stop Date. 58 D 25^PSIVEDT1 59 Q 60 26 ; Schedule 61 D 26^PSIVEDT1 62 Q 63 ; 64 39 ; Admin Times. 65 D 39^PSIVEDT1 66 Q 67 ; 68 57 ; Additive. 69 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q 70 . W !!?5,"Additive may not be edited at this point." D PAUSE^VALM1 71 I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q 72 .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Provider may not be edited at this point." D PAUSE^VALM1 73 I $E(PSIVAC)="O" W !!,"Only additives marked for use in IV Fluid Order Entry may be selected." 74 S FIL=52.6,DRGT="AD",DRGTN="ADDITIVE" D DRG^PSIVEDRG,DKILL 75 Q 76 ; 77 58 ; Solution. 78 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q 79 . W !!?5,"Solution may not be edited at this point." D PAUSE^VALM1 80 S FIL=52.7,DRGT="SOL",DRGTN="SOLUTION" D DRG^PSIVEDRG 81 ; 82 DKILL ; Kill for drug edit. 83 K DRGI,DRGN,DRGT,DRGTN,FIL,PSIVSTR 84 Q 85 ; 86 59 ; Infusion Rate. 87 D 59^PSIVEDT1 88 Q 89 ; 90 62 ; IV Room. 91 N DIR S DIR(0)="PA^59.5",DIR("A")="IV Room: ",DIR("??")="^S F1=59.5,F2=.01 D ENHLP^PSIVORC1" S:P("IVRM") DIR("B")=$P(P("IVRM"),U,2) 92 D ^DIR Q:$D(DIRUT) I Y>0 S P("IVRM")=Y W $P($P(Y,U,2),X,2) 93 Q 94 ; 95 63 ; Remarks. 96 D 63^PSIVEDT1 97 Q 98 ; 99 64 ; Other Print Info. 100 D 64^PSIVEDT1 101 Q 102 ; 103 66 ; Provider's comments. 104 N DA,DIE,DIR S DA=PSIVUP,DIE="^PS(53.45,",DR=4 D ^DIE S PSGSI=X,Y=1 105 Q 106 ; 107 101 ; Orderable Item. 108 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q 109 . W !!?5,"This is Renewal order. Orderable Item may not be edited at this point." D PAUSE^VALM1 110 I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q 111 .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Orderable Item may not be edited at this point." D PAUSE^VALM1 112 W !,"Orderable Item: "_$S(P("PD"):$P(P("PD"),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(X=""&P("PD")) Q 113 I X]"" N DIC S DIC="^PS(50.7,",DIC(0)="EMQZ",DIC("B")=$S(P("PD")]"":+$P(("PD"),U),1:""),DIC("S")="S PSJSCT=1 I $$DRGSC^PSIVUTL(Y,PSJSCT) K PSJSCT" D ^DIC K DIC I Y>0 S P("PD")=Y Q 114 W $C(7),!!,"Orderable Item is required!",!! G 101 115 Q 116 109 ; Dosage Ordered. 117 W !,"DOSAGE ORDERED: "_$S(P("DO")]"":P("DO")_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(P("DO")]""&(X="")) Q 118 I X="???" D ORFLDS^PSIVEDT1 G 109 119 D:X]"" CHK^DIE(53.1,109,"",X,.X) I $G(X)="^" W $C(7),!!,"Enter the dosage in which the Orderable Item entered should be dispensed.",! W "Answer must be 1-20 characters in length." G 109 120 S P("DO")=X 121 Q 122 ; 123 FF ; up-arrow to another field. 124 N DIC S X=$P(X,U,2),DIC="^DD(53.1,",DIC(0)="QEM",DIC("S")="I U_PSIVOK_U[(U_+Y_U)" D ^DIC K DIC S Y=+Y 125 Q 126 ; 127 NEWDRG ; Ask if adding a new drug. 128 K DIR S DIR(0)="Y",DIR("A")="Are you adding "_$P(TDRG,U,2)_" as a new "_$S(DRGT="AD":"additive",1:"solution")_" for this order",DIR("B")="NO" D ^DIR I $D(DTOUT)!$D(DUOUT) Q 129 I Y S (DRGI,DRG(DRGT,0))=DRG(DRGT,0)+1,DRG=TDRG,DRG(DRGT,+DRGI)=+DRG_U_$P(DRG,U,2) I DRGT="SOL" S X=$G(^PS(52.7,+DRG,0)),$P(DRG(DRGT,DRG),U,3)=$P(X,U,3) 130 Q 1 PSIVEDT ;BIR/MLM-EDIT IV ORDER ;10 Feb 98 / 3:23 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**4,110,127,133**;16 DEC 97 3 ; 4 ; Reference to ^DD(53.1 is supported by DBIA 2256. 5 ; Reference to ^PS(52.7 is supported by DBIA 2173. 6 ; Reference to ^PS(52.6 is supported by DBIA 1231. 7 ; Reference to ^PS(51.2 is supported by DBIA 2178. 8 ; Reference to ^PS(50.7 is supported by DBIA 2180. 9 ; Reference to ^PS(55 is supported by DBIA 2191. 10 ; 11 EDIT ; 12 I $G(DFN)&($G(PSJORD)["V") I $$COMPLEX^PSJOE(DFN,PSJORD) D 13 . N X,Y,PARENT,P2ND S P2ND=$S($G(^PS(55,PSGP,"IV",+PSJORD,.2)):$G(^PS(55,PSGP,"IV",+PSJORD,.2)),1:$G(^PS(55,PSGP,5,+PSJORD,.2))) 14 . S PARENT=$P(P2ND,"^",8) 15 . I PARENT D FULL^VALM1 W !!?5,"This order is part of a complex order. Please review the following ",!?5,"associated orders before changing this order." D CMPLX^PSJCOM1(PSGP,PARENT,PSJORD) 16 S DONE=0 17 F PSIVE=1:1 S:DONE&$E(PSIVAC)="C" OREND=1 Q:PSIVE>$L(EDIT,U)!(DONE) Q:'$L($P(EDIT,U,PSIVE)) D @($P(EDIT,U,PSIVE)) S:$E(PSIVAC,2)="N" PSIVOK=PSIVOK_U_$P(EDIT,U,PSIVE) I $E(X)=U,$L(X)>1 S:PSIVE>1 PSIVE=PSIVE-1 F D FF Q:Y<0 D @Y Q:$E(X)'=U 18 K EDIT,PSIVOK,PSGDI 19 Q 20 ; 21 1 ; Provider. 22 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+$G(ON),0)),"^",24)="R" D Q 23 . W !!?5,"This is Renewal order. Provider may not be edited at this point." D PAUSE^VALM1 24 I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q 25 .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Provider may not be edited at this point." D PAUSE^VALM1 26 S P(6)=$S('$G(^VA(200,+P(6),"PS")):"",'$P(^("PS"),U,4):P(6),$P(^("PS"),U,4)<DT:"",1:P(6)) 27 W !,"PROVIDER: "_$S($P(P(6),U,2)]"":$P(P(6),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(X=""&P(6)) Q 28 I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS^PSIVEDT1 G 1 29 I X]"" K DIC S DIC=200,DIC(0)="EQMZ",DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),U,4):1,$P(^(""PS""),U,4)>DT:1,1:0)" D ^DIC K DIC I Y>0 S P(6)=+Y_U_Y(0,0) Q 30 S F1=53.1,F2=1 D ENHLP^PSIVORC1 W $C(7),!!,"A Provider must be entered.",!! G 1 31 Q 32 ; 33 3 ; Med Route. 34 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q 35 . W !!?5,"Med Route may not be edited at this point." D PAUSE^VALM1 36 I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q 37 .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Med Route may not be edited at this point." D PAUSE^VALM1 38 S P(6)=$S('$G(^VA(200,+P(6),"PS")):"",'$P(^("PS"),U,4):P(6),$P(^("PS"),U,4)<DT:"",1:P(6)) 39 I P("MR")="" S X=$O(^PS(51.2,"B","INTRAVENOUS",0)) I $P($G(^PS(51.2,+X,0)),U,4) S P("MR")=+X_U_$P(^(0),U,3) 40 W !,"MED ROUTE: "_$S($P(P("MR"),U,2)]"":$P(P("MR"),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I X=U!(X=""&P("MR"))!($E(X)=U) Q 41 I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS^PSIVEDT1 G 3 42 I X]"" K DIC S DIC=51.2,DIC(0)="EQMZ",DIC("S")="I $P(^(0),U,4)" D ^DIC K DIC I Y>0 S P("MR")=+Y_U_$P(Y(0),U,3) Q 43 S F1=53.1,F2=3 D ENHLP^PSIVORC1 W $C(7),!!,"A Med Route must be entered." G 3 44 Q 45 ; 46 10 ; Start Date. 47 D 10^PSIVEDT1 48 Q 49 ; 50 25 ; Stop Date. 51 D 25^PSIVEDT1 52 Q 53 26 ; Schedule 54 D 26^PSIVEDT1 55 Q 56 ; 57 39 ; Admin Times. 58 D 39^PSIVEDT1 59 Q 60 ; 61 57 ; Additive. 62 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q 63 . W !!?5,"Additive may not be edited at this point." D PAUSE^VALM1 64 I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q 65 .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Provider may not be edited at this point." D PAUSE^VALM1 66 I $E(PSIVAC)="O" W !!,"Only additives marked for use in IV Fluid Order Entry may be selected." 67 S FIL=52.6,DRGT="AD",DRGTN="ADDITIVE" D DRG^PSIVEDRG,DKILL 68 Q 69 ; 70 58 ; Solution. 71 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q 72 . W !!?5,"Solution may not be edited at this point." D PAUSE^VALM1 73 S FIL=52.7,DRGT="SOL",DRGTN="SOLUTION" D DRG^PSIVEDRG 74 ; 75 DKILL ; Kill for drug edit. 76 K DRGI,DRGN,DRGT,DRGTN,FIL,PSIVSTR 77 Q 78 ; 79 59 ; Infusion Rate. 80 D 59^PSIVEDT1 81 Q 82 ; 83 62 ; IV Room. 84 N DIR S DIR(0)="PA^59.5",DIR("A")="IV Room: ",DIR("??")="^S F1=59.5,F2=.01 D ENHLP^PSIVORC1" S:P("IVRM") DIR("B")=$P(P("IVRM"),U,2) 85 D ^DIR Q:$D(DIRUT) I Y>0 S P("IVRM")=Y W $P($P(Y,U,2),X,2) 86 Q 87 ; 88 63 ; Remarks. 89 D 63^PSIVEDT1 90 Q 91 ; 92 64 ; Other Print Info. 93 D 64^PSIVEDT1 94 Q 95 ; 96 66 ; Provider's comments. 97 N DA,DIE,DIR S DA=PSIVUP,DIE="^PS(53.45,",DR=4 D ^DIE S PSGSI=X,Y=1 98 Q 99 ; 100 101 ; Orderable Item. 101 I $G(P("RES"))="R" I $G(PSJORD)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q 102 . W !!?5,"This is Renewal order. Orderable Item may not be edited at this point." D PAUSE^VALM1 103 I $G(DFN)&($G(ON)["V") I $$COMPLEX^PSJOE(DFN,ON) D Q 104 .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Orderable Item may not be edited at this point." D PAUSE^VALM1 105 W !,"Orderable Item: "_$S(P("PD"):$P(P("PD"),U,2)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(X=""&P("PD")) Q 106 I X]"" N DIC S DIC="^PS(50.7,",DIC(0)="EMQZ",DIC("B")=$S(P("PD")]"":+$P(("PD"),U),1:""),DIC("S")="S PSJSCT=1 I $$DRGSC^PSIVUTL(Y,PSJSCT) K PSJSCT" D ^DIC K DIC I Y>0 S P("PD")=Y Q 107 W $C(7),!!,"Orderable Item is required!",!! G 101 108 Q 109 109 ; Dosage Ordered. 110 W !,"DOSAGE ORDERED: "_$S(P("DO")]"":P("DO")_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(P("DO")]""&(X="")) Q 111 I X="???" D ORFLDS^PSIVEDT1 G 109 112 D:X]"" CHK^DIE(53.1,109,"",X,.X) I $G(X)="^" W $C(7),!!,"Enter the dosage in which the Orderable Item entered should be dispensed.",! W "Answer must be 1-20 characters in length." G 109 113 S P("DO")=X 114 Q 115 ; 116 FF ; up-arrow to another field. 117 N DIC S X=$P(X,U,2),DIC="^DD(53.1,",DIC(0)="QEM",DIC("S")="I U_PSIVOK_U[(U_+Y_U)" D ^DIC K DIC S Y=+Y 118 Q 119 ; 120 NEWDRG ; Ask if adding a new drug. 121 K DIR S DIR(0)="Y",DIR("A")="Are you adding "_$P(TDRG,U,2)_" as a new "_$S(DRGT="AD":"additive",1:"solution")_" for this order",DIR("B")="NO" D ^DIR I $D(DTOUT)!$D(DUOUT) Q 122 I Y S (DRGI,DRG(DRGT,0))=DRG(DRGT,0)+1,DRG=TDRG,DRG(DRGT,+DRGI)=+DRG_U_$P(DRG,U,2) I DRGT="SOL" S X=$G(^PS(52.7,+DRG,0)),$P(DRG(DRGT,DRG),U,3)=$P(X,U,3) 123 Q
Note:
See TracChangeset
for help on using the changeset viewer.