- 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/PSIVOREN.m
r613 r623 1 PSIVOREN ;BIR/MLM-UTILITIES FOR IV FLUIDS - OE/RR INTERFACE ; 25 Sep 98 / 2:00 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**3,18,69,110,127,133,140,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^PS(55 is supported by DBIA 2191. 5 ; Reference to ^VA(200 is supported by DBIA 10060. 6 ; Reference to ^DIE is supported by DBIA 10018. 7 ; 8 ENCPP ; Check Package Parameter 9 D ORPARM I 'PSJORF W !!,"Inpatient Medications is not turned on for OE/RR.",!,"You will not be able to enter or edit IV or Unit Dose orders." 10 I 'PSJIVORF W !!,"IV Medications is not turned on for OE/RR.",!,"You will not be able to enter or edit IV orders." 11 I 'PSJORF!'PSJIVORF S PSJIVORF="" D DONE^PSIVORA1 Q 12 S PSJORL=$G(VAIN(4)) I 'PSJORL,$G(DFN) D INP^VADPT S PSJORL=$G(VAIN(4)) 13 S PSJORPF=0,P("OT")="F^",PSJORNP=$S($G(PSJORNP):PSJORNP,1:+$G(DUZ)) 14 Q 15 ; 16 PS ; Check if MD is authorized to write med. orders. 17 S PSJORPF=0 S:PSJORNP X=$G(^VA(200,+PSJORNP,"PS")) Q:$S('PSJORNP:0,'X:0,'$P(X,U,4):1,$P(X,U,4)>DT:1,1:0) D 18 .W !?2,"(The selected PROVIDER is NOT qualified to write MEDICATION orders. You must",!,"select a valid provider to be able to continue with Inpatient Medications.)" 19 .K DIC S DIC="^VA(200,",DIC(0)="AEMQZ",DIC("A")="Select PHARMACY PROVIDER: ",DIC("S")="S PSIV=$G(^(""PS"")) I PSIV,$S($P(PSIV,""^"",4)="""":1,DT<$P(PSIV,""^"",4):1,1:0)" F W ! D ^DIC Q:$D(DUOUT)!$D(DTOUT)!(Y>0) W $C(7)," (Required.)" 20 .K DIC S:Y'>0 PSJORPF=11 S:Y>0 PSJORNP=+Y Q 21 K DTOUT 22 Q 23 ; 24 RUPDATE(DFN,ON,NSTRT) ; 25 ; Update renewal orders (called from Pharmacy options). 26 N DA,DIE,DR,ND,NSTOP,OSTOP,NOO,ORETURN,PSIVACT,PSIVAL,PSIVALCK,PSJOSTRT,PSGOLDOE S DIE="^PS(55,"_DFN_"," 27 I ON["P" S OLDON=$P($G(^PS(53.1,+ON,0)),"^",25),NOO=$P($G(^PS(53.1,+ON,.2)),"^",3) 28 I ON["V" S OLDON=ON,NOO=$P($G(^PS(55,DFN,"IV",+ON,.2)),"^",5) 29 I ON["U" S OLDON=$P($G(^PS(55,DFN,5,+ON,0)),U,25) 30 I OLDON["P" S OLDON=$P($G(^PS(53.1,+OLDON,0)),U,25) 31 I OLDON["V" S ON55=OLDON,X=$G(^PS(55,DFN,"IV",+OLDON,2)),PSJOSTRT=$P(X,U,7),OSTOP=$S(($G(PSJOSTOP)>PSJOSTRT):PSJOSTOP,1:$P($G(^(0)),U,3)),DIE=DIE_"""IV"",",DR="100////A",PSIVACT=1 32 I OLDON["U" S X=$G(^PS(55,DFN,5,+OLDON,2)),PSJOSTRT=$P(X,U,7),OSTOP=$P(X,U,4),DIE=DIE_"5," 33 S NSTOP=+$S($G(P(3)):P(3),1:0),DA=+OLDON,DA(1)=DFN I 'NSTOP W !,"CAN'T RENEW THIS ORDER!" D PAUSE^VALM1 Q 34 ; 35 I ON["V"!(ON["P") D EXPOE^PSGOER(DFN,ON) 36 ; 37 S DR=DR_";"_$S(OLDON["V":.03,OLDON["U":34,1:25)_"////"_NSTOP_";"_$S(OLDON["V":"114////@;123////@",1:"105////@;107////@") S:+$G(P(6))?1.30N DR=DR_";.06////"_+P(6) D ^DIE 38 I ON["P" S DIE="^PS(53.1,",DR="28////A;105////@;",DA=+ON D ^DIE D 39 .I $G(OLDON)["V" S PSGOLDOE=$P($G(^PS(55,DFN,"IV",+OLDON,0)),"^",21) 40 .N NOEORD,VN,VNDT S NOEORD=$P(^PS(53.1,+ON,0),U,21) S VN=$P($G(^PS(53.1,+ON,4)),"^") I VN S VNDT=$P($G(^PS(53.1,+ON,4)),"^",2) 41 .I NOEORD K DA,DR,DIE S DIE="^PS(55,"_DFN_",""IV"",",DA(1)=DFN,DA=+ON55,DR="110////"_+NOEORD D 42 ..S DR=DR_";16////"_$S($G(VN):VN,1:"@")_";17////"_$S($G(VNDT):VNDT,1:"@")_";" D ^DIE I NOEORD[";" S $P(^PS(53.1,+ON,0),U,21)=NOEORD 43 ..I $G(VN) D EN1^PSJHL2(DFN,"ZV",ON55) 44 I ON["V" S DIE="^PS(55,DFN,""IV"",",DR="100////A;114////@;16////@;17////@" S DA=+ON55 D ^DIE 45 N RDT S RDT=$P($G(@("^PS(53.1,"_+ON_",14,0)")),U,3) S:RDT RDT=+(^(RDT,0)) S RDT=$S(RDT:RDT,1:$$DATE^PSJUTL2) I RDT D UPDREN^PSIVOPT2(DFN,OLDON,RDT,+P(6),+$G(OSTOP),$G(NOO)) 46 ; 47 I ON["V" D EN1^PSJHL2(DFN,"SN",ON,"NEW ORDER CREATED") 48 I OLDON["V" S (ON,ON55)=OLDON,PSIVAL="",PSIVALCK="STOP",(P("FRES"),PSIVREA)="R" D LOG^PSIVORAL D 49 .I $G(ON55),$G(OSTOP),$G(DFN) D STIX(OSTOP,OLDON,DFN) 50 .;Add check to If statement below. If New Stop date ='s the old Stop Don't delete AIV x-ref (NSTOP'=PSJOSTOP) 51 .I $G(PSJOSTOP),$G(NSTOP) I NSTOP=$P($G(^PS(55,DFN,"IV",+ON55,0)),"^",3),$D(^PS(55,"AIV",NSTOP,DFN,+ON55)),NSTOP'=PSJOSTOP K ^PS(55,"AIV",PSJOSTOP,DFN,+ON55) 52 D:'$D(PSJIVORF) ORPARM Q:'PSJIVORF 53 Q 54 ; 55 RUPTXT(DFN,OLDON) ; 56 ;Update ORTX( in OE/RR 57 I OLDON'["V" ;; D ENUDTX^PSJOREN(DFN,OLDON,"OR") S ORIFN=$P($G(^PS(55,DFN,"IV",+OLDON,0)),U,21) 58 I OLDON["V" S P("FRES")="R" D GTPC^PSIVORFB(OLDON),SORTX^PSIVORFE S ORIFN=$P($G(^PS(55,DFN,"IV",+OLDON,0)),U,21) 59 Q 60 ; 61 ORPARM ;Check if inpatient pkges are on. 62 S (PSJORF,PSJIVORF)=1 63 Q 64 ; 65 NATURE ; Ask nature of order. 66 Q:$G(PSJDCTYP)=2 67 I '+$G(PSJSYSU) S P("NAT")="W" Q 68 K P("NAT") NEW X 69 I $D(XQORNOD(0)) S X=$E($P(XQORNOD(0),U,3),1,1) S:X="" X="E" 70 S:'$D(X) X="N" S:"AF"[X X="E" 71 I $G(PSIVCOPY) S X="N" 72 S P("NAT")=$$ENNOO^PSJUTL5(X) 73 K:P("NAT")=-1 P("NAT") 74 Q 75 CLINIC ;Ask clinic where outpt is being seen for DSS 76 K P("CLIN") NEW X1,X2,X,PSJDT,DIC,Y 77 S X1=DT,X2=-7 D C^%DTC S PSJDT=X 78 S DIC("S")="I $P($G(^SC(Y,0)),U,3)=""C"",$S('$P($G(^(""I"")),U):1,($P($G(^(""I"")),U)>PSJDT):1,(($P($G(^(""I"")),U)<PSJDT)&($P($G(^(""I"")),U,2)]"""")&(DT>$P($G(^(""I"")),U,2))):1,1:0)" 79 S DIC=44,DIC(0)="QEAZ",DIC("A")="Select CLINIC LOCATION: " D ^DIC 80 I $S($D(DTOUT):1,$D(DUOUT):1,1:0) Q 81 S:+Y>0 P("CLIN")=+Y,$P(^PS(55,DFN,"IV",+ON55,"DSS"),"^")=+Y 82 Q 83 ; 84 STIX(OST,OON,DFN) ; Check start index, cleanup old start 85 I $G(OST),$G(OON) S OS="" F S OS=$O(^PS(55,DFN,"IV","AIS",OS)) Q:'OS D 86 . Q:'$D(^PS(55,DFN,"IV","AIS",OS,+OON)) 87 . I $P($G(^PS(55,DFN,"IV",+OON,0)),"^",3)'=OS K ^PS(55,DFN,"IV","AIS",OS,+OON) 88 Q 1 PSIVOREN ;BIR/MLM-UTILITIES FOR IV FLUIDS - OE/RR INTERFACE ; 25 Sep 98 / 2:00 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**3,18,69,110,127,133,140**;16 DEC 97 3 ; 4 ; Reference to ^PS(55 is supported by DBIA 2191. 5 ; Reference to ^VA(200 is supported by DBIA 10060. 6 ; Reference to ^DIE is supported by DBIA 10018. 7 ; 8 ENCPP ; Check Package Parameter 9 D ORPARM I 'PSJORF W !!,"Inpatient Medications is not turned on for OE/RR.",!,"You will not be able to enter or edit IV or Unit Dose orders." 10 I 'PSJIVORF W !!,"IV Medications is not turned on for OE/RR.",!,"You will not be able to enter or edit IV orders." 11 I 'PSJORF!'PSJIVORF S PSJIVORF="" D DONE^PSIVORA1 Q 12 S PSJORL=$G(VAIN(4)) I 'PSJORL,$G(DFN) D INP^VADPT S PSJORL=$G(VAIN(4)) 13 S PSJORPF=0,P("OT")="F^",PSJORNP=$S($G(PSJORNP):PSJORNP,1:+$G(DUZ)) 14 ;; S PSJORL=ORL,PSJORPF=0,P("OT")="F^"_$O(^ORD(101,"B","PSJI OR PAT FLUID OE",0))_";ORD(101,",PSJORNP=ORNP 15 Q 16 ; 17 PS ; Check if MD is authorized to write med. orders. 18 S PSJORPF=0 S:PSJORNP X=$G(^VA(200,+PSJORNP,"PS")) Q:$S('PSJORNP:0,'X:0,'$P(X,U,4):1,$P(X,U,4)>DT:1,1:0) D 19 .W !?2,"(The selected PROVIDER is NOT qualified to write MEDICATION orders. You must",!,"select a valid provider to be able to continue with Inpatient Medications.)" 20 .K DIC S DIC="^VA(200,",DIC(0)="AEMQZ",DIC("A")="Select PHARMACY PROVIDER: ",DIC("S")="S PSIV=$G(^(""PS"")) I PSIV,$S($P(PSIV,""^"",4)="""":1,DT<$P(PSIV,""^"",4):1,1:0)" F W ! D ^DIC Q:$D(DUOUT)!$D(DTOUT)!(Y>0) W $C(7)," (Required.)" 21 .K DIC S:Y'>0 PSJORPF=11 S:Y>0 PSJORNP=+Y Q 22 K DTOUT 23 Q 24 ; 25 RUPDATE(DFN,ON,NSTRT) ; 26 ; Update renewal orders (called from Pharmacy options). 27 N DA,DIE,DR,ND,NSTOP,OSTOP,NOO,ORETURN,PSIVACT,PSIVAL,PSIVALCK,PSJOSTRT,PSGOLDOE S DIE="^PS(55,"_DFN_"," 28 I ON["P" S OLDON=$P($G(^PS(53.1,+ON,0)),"^",25),NOO=$P($G(^PS(53.1,+ON,.2)),"^",3) 29 I ON["V" S OLDON=ON,NOO=$P($G(^PS(55,DFN,"IV",+ON,.2)),"^",5) 30 I ON["U" S OLDON=$P($G(^PS(55,DFN,5,+ON,0)),U,25) 31 I OLDON["P" S OLDON=$P($G(^PS(53.1,+OLDON,0)),U,25) 32 I OLDON["V" S ON55=OLDON,X=$G(^PS(55,DFN,"IV",+OLDON,2)),PSJOSTRT=$P(X,U,7),OSTOP=$S(($G(PSJOSTOP)>PSJOSTRT):PSJOSTOP,1:$P($G(^(0)),U,3)),DIE=DIE_"""IV"",",DR="100////A",PSIVACT=1 33 I OLDON["U" S X=$G(^PS(55,DFN,5,+OLDON,2)),PSJOSTRT=$P(X,U,7),OSTOP=$P(X,U,4),DIE=DIE_"5," 34 S NSTOP=+$S($G(P(3)):P(3),1:0),DA=+OLDON,DA(1)=DFN I 'NSTOP W !,"CAN'T RENEW THIS ORDER!" D PAUSE^VALM1 Q 35 ;I OSTOP>NSTOP W !,"NEW STOP DATE IS LESS THAN PREVIOUS STOP DATE" D PAUSE^VALM1 36 ; 37 I ON["V"!(ON["P") D EXPOE^PSGOER(DFN,ON) 38 ; 39 S DR=DR_";"_$S(OLDON["V":.03,OLDON["U":34,1:25)_"////"_NSTOP_";"_$S(OLDON["V":"114////@;123////@",1:"105////@;107////@") S:+$G(P(6))?1.30N DR=DR_";.06////"_+P(6) D ^DIE 40 I ON["P" S DIE="^PS(53.1,",DR="28////A;105////@;",DA=+ON D ^DIE D 41 .I $G(OLDON)["V" S PSGOLDOE=$P($G(^PS(55,DFN,"IV",+OLDON,0)),"^",21) 42 .N NOEORD,VN,VNDT S NOEORD=$P(^PS(53.1,+ON,0),U,21) S VN=$P($G(^PS(53.1,+ON,4)),"^") I VN S VNDT=$P($G(^PS(53.1,+ON,4)),"^",2) 43 .I NOEORD K DA,DR,DIE S DIE="^PS(55,"_DFN_",""IV"",",DA(1)=DFN,DA=+ON55,DR="110////"_+NOEORD D 44 ..S DR=DR_";16////"_$S($G(VN):VN,1:"@")_";17////"_$S($G(VNDT):VNDT,1:"@")_";" D ^DIE I NOEORD[";" S $P(^PS(53.1,+ON,0),U,21)=NOEORD 45 ..I $G(VN) D EN1^PSJHL2(DFN,"ZV",ON55) 46 I ON["V" S DIE="^PS(55,DFN,""IV"",",DR="100////A;114////@;16////@;17////@" S DA=+ON55 D ^DIE 47 N RDT S RDT=$P($G(@("^PS(53.1,"_+ON_",14,0)")),U,3) S:RDT RDT=+(^(RDT,0)) S RDT=$S(RDT:RDT,1:$$DATE^PSJUTL2) I RDT D UPDREN^PSIVOPT2(DFN,OLDON,RDT,+P(6),+$G(OSTOP),$G(NOO)) 48 ; 49 I ON["V" D EN1^PSJHL2(DFN,"SN",ON,"NEW ORDER CREATED") 50 I OLDON["V" S (ON,ON55)=OLDON,PSIVAL="",PSIVALCK="STOP",(P("FRES"),PSIVREA)="R" D LOG^PSIVORAL D 51 .I $G(ON55),$G(OSTOP),$G(DFN) D STIX(OSTOP,OLDON,DFN) 52 .;Add check to If statement below. If New Stop date ='s the old Stop Don't delete AIV x-ref (NSTOP'=PSJOSTOP) 53 .I $G(PSJOSTOP),$G(NSTOP) I NSTOP=$P($G(^PS(55,DFN,"IV",+ON55,0)),"^",3),$D(^PS(55,"AIV",NSTOP,DFN,+ON55)),NSTOP'=PSJOSTOP K ^PS(55,"AIV",PSJOSTOP,DFN,+ON55) 54 D:'$D(PSJIVORF) ORPARM Q:'PSJIVORF 55 Q 56 ; 57 RUPTXT(DFN,OLDON) ; 58 ;Update ORTX( in OE/RR 59 I OLDON'["V" ;; D ENUDTX^PSJOREN(DFN,OLDON,"OR") S ORIFN=$P($G(^PS(55,DFN,"IV",+OLDON,0)),U,21) 60 I OLDON["V" S P("FRES")="R" D GTPC^PSIVORFB(OLDON),SORTX^PSIVORFE S ORIFN=$P($G(^PS(55,DFN,"IV",+OLDON,0)),U,21) 61 ;; F X=0:0 S X=$O(ORTX(X)) Q:'X S ORETURN("ORTX",X)=ORTX(X) 62 Q 63 ; 64 ORPARM ;Check if inpatient pkges are on. 65 S (PSJORF,PSJIVORF)=1 66 Q 67 ; 68 NATURE ; Ask nature of order. 69 I '+$G(PSJSYSU) S P("NAT")="W" Q 70 K P("NAT") NEW X 71 I $D(XQORNOD(0)) S X=$E($P(XQORNOD(0),U,3),1,1) S:X="" X="E" 72 ;* S:'$D(X) X="N" S:X="A" X="E" 73 S:'$D(X) X="N" S:"AF"[X X="E" 74 I $G(PSIVCOPY) S X="N" 75 S P("NAT")=$$ENNOO^PSJUTL5(X) 76 K:P("NAT")=-1 P("NAT") 77 Q 78 CLINIC ;Ask clinic where outpt is being seen for DSS 79 K P("CLIN") NEW X1,X2,X,PSJDT,DIC,Y 80 S X1=DT,X2=-7 D C^%DTC S PSJDT=X 81 S DIC("S")="I $P($G(^SC(Y,0)),U,3)=""C"",$S('$P($G(^(""I"")),U):1,($P($G(^(""I"")),U)>PSJDT):1,(($P($G(^(""I"")),U)<PSJDT)&($P($G(^(""I"")),U,2)]"""")&(DT>$P($G(^(""I"")),U,2))):1,1:0)" 82 S DIC=44,DIC(0)="QEAZ",DIC("A")="Select CLINIC LOCATION: " D ^DIC 83 I $S($D(DTOUT):1,$D(DUOUT):1,1:0) Q 84 S:+Y>0 P("CLIN")=+Y,$P(^PS(55,DFN,"IV",+ON55,"DSS"),"^")=+Y 85 Q 86 ; 87 STIX(OST,OON,DFN) ; Check start index, cleanup old start 88 I $G(OST),$G(OON) S OS="" F S OS=$O(^PS(55,DFN,"IV","AIS",OS)) Q:'OS D 89 . Q:'$D(^PS(55,DFN,"IV","AIS",OS,+OON)) 90 . I $P($G(^PS(55,DFN,"IV",+OON,0)),"^",3)'=OS K ^PS(55,DFN,"IV","AIS",OS,+OON) 91 Q
Note:
See TracChangeset
for help on using the changeset viewer.
