- 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/PSIVORA.m
r613 r623 1 PSIVORA ;BIR/MLM-MAIN DRIVER FOR IV FLUIDS - OE/RR INTERFACE ;08 JAN 97 / 2:47 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**29,41,110,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^PS(55 is supported by DBIA 2191 5 ; 6 EN ; Entry point called by IV Fluid protocol. 7 S X=ORACTION,PSIVAC="O"_$S(X=0:"N",X=1:"E",X=2:"R",X=4:"H",X=6:"D",X="8":"S",1:"") S:X'=5&(X'=7) PSIVUP=+$$GTPCI^PSIVUTL 8 S (PSGP,DFN)=+ORVP,PSJACNWP=1 D ^PSJAC I "578"[ORACTION D @ORACTION,DONE^PSIVORA1 Q 9 D ENCPP^PSIVOREN Q:'PSJIVORF!('PSJORF) D EN1,DONE^PSIVORA1 10 Q 11 ; 12 EN1 ; Take action on existing order. 13 S PSJORD=$G(ORPK) I ORGY>8 D @ORGY Q 14 I 'ORACTION D ^PSIVORFE Q 15 I '$G(ORPK) W !,"INSUFFICIENT INFORMATION, CANNOT CONTINUE." S OREND=1 Q 16 I ORPK["V",($P($G(^PS(55,DFN,"IV",+ORPK,0)),U,17)="O") D ONCALL^PSIVORV1 Q 17 I ORACTION<3 S P("FRES")=$S(ORPK["V":$P($G(^PS(55,DFN,"IV",+ORPK,2)),U,9),1:$P($G(^PS(53.1,+ORPK,0)),U,27)) I P("FRES")]"" D @$S(P("FRES")="R":"ALLREN^PSIVORV1",1:"ALLED^PSIVORV1") Q 18 S PSJORSTS=ORSTS,PSJORIFN=ORIFN L +@$S(PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD)",1:"^PS(53.1,+PSJORD)"):1 E D LOCKERR^PSIVORA1 Q 19 D @ORACTION L -@$S(PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD)",1:"^PS(53.1,+PSJORD)") 20 Q 21 ; 22 1 ; Edit an existing order. 23 D EDIT^PSIVORA1 24 Q 25 ; 26 2 ; Renew 27 D RENEW^PSIVORA1 28 Q 29 ; 30 3 ; Flag 31 Q 32 ; 33 4 ; Hold 34 I ORSTS'=3,ORSTS'=6 W !,$C(7),"Only ACTIVE orders may be placed on HOLD." S OREND=1 Q 35 S PSIVREA=$S(ORSTS=6:"H",1:"U"),ON55=PSJORD,$P(^PS(55,DFN,"IV",+ON55,0),U,10)=$S(PSIVREA="H":1,1:""),Y=$G(^PS(55,DFN,"IV",+ON55,0)),P(3)=$P(Y,U,3),P(17)=$P(Y,U,17) 36 D NOW^%DTC I ORSTS=3,P(3)<% S P(17)="E" D UPSTAT^PSIVOPT S ORSTS=7 W $C(7)," This order has expired." Q 37 S XED=0,PSIVALT=2,P(17)=$S(PSIVREA="H":"H",1:"A") D UPSTAT^PSIVOPT,LOG^PSIVORAL S ORSTS=$S(PSIVREA="H":3,1:6) 38 Q 39 ; 40 5 ; Event 41 N DA,DIE,DR,ON,P,PSIVACT,X 42 S ON=ORPK I ON["V" S X=$G(^PS(55,+ORVP,"IV",+ON,0)),P(3)=$P(X,U,3),P(17)=$P(X,U,17) 43 I ON'["V" S P(3)=$P($G(^PS(53.1,+ON,2)),U,4),P(17)=$P($G(^PS(53.1,+ON,0)),U,9) 44 Q:"AR"'[P(17) D NOW^%DTC Q:P(3)>% 45 I ON["V" S DR="100///E",DIE="^PS(55,"_+ORVP_",""IV"",",DA(1)=+ORVP 46 I ON'["V" S DR="28///E",DIE="^PS(53.1," 47 S PSIVACT=1,DA=+ON D ^DIE S ORSTS=7 48 Q 49 ; 50 6 ; Cancel - Delete pending or unreleased orders from Nonverified orders 51 ; (53.1) and Orders (100) files. 52 I ORSTS=1 W $C(7),!,"This order has already been DISCONTINUED." Q 53 I ORSTS=7 W $C(7),!,"Expired orders cannot be DISCONTINUED." Q 54 I PSJORD'["V",ORSTS=11 D Q 55 .S P("OLDON")=$P($G(^PS(53.1,+PSJORD,0)),U,25) I P("OLDON") D 56 ..I P("OLDON")["V",$D(^PS(55,DFN,"IV",+P("OLDON"),2)) S PSJRES=$P(^(2),U,9) S:PSJRES'="R" $P(^(2),U,6)="",$P(^(2),U,9)="" ;; D:PSJRES="R" ENBKOUT^PSJOREN(DFN,PSJORD) 57 ..I P("OLDON")'["V",$D(^PS(53.1,+P("OLDON"),0)) S PSJRES=$P(^(0),U,27) S:PSJRES'="R" $P(^(0),U,26,27)="^" I PSJRES="R" ;; D ENBKOUT^PSJOREN(DFN,PSJORD) 58 .K DA,DIK S DIK="^PS(53.1,",DA=+PSJORD D ^DIK S PSGP=DFN,X="P" D ENSK^PSGAXR K DA,DIK S ORIFN=PSJORIFN,ORSTS="K" Q 59 ; 60 DC ; DC order from Pharmacy complete function. 61 I PSJORD["V",'PSJCOM N PSIVREA S ON55=PSJORD,X=$G(^PS(55,DFN,"IV",+ON55,0)),P(3)=$P(X,U,3),P(17)=$P(X,U,17),PSIVREA="D",PSIVALT=2,PSIVALCK="STOP" D D^PSIVOPT2 D HL Q 62 I PSJORD["V",PSJCOM N PSIVREA S ON55=PSJORD,X=$G(^PS(55,DFN,"IV",+ON55,0)),P(3)=$P(X,U,3),P(17)=$P(X,U,17),PSIVREA="D",PSIVALT=2,PSIVALCK="STOP" D D^PSIVOPT2 Q 63 N DA,DR,DIE,PSJND S DA=+PSJORD,PSJND=$G(^PS(53.1,DA,0)),P("OLDON")=$P(PSJND,U,25),DIE="^PS(53.1,",DR="28///"_$S($P(PSJND,U,27)="E":"DE",1:"D") D ^DIE 64 D HL 65 Q 66 HL ; 67 Q:'$D(P("NAT")) 68 NEW PSJCD,PSJTX,PSJOTMP 69 I PSJORD["P" N PSJNOO S PSJCD="OC",PSJTX="ORDER CANCELED",PSJNOO=$G(P("NAT")) 70 E S PSJCD="OD",PSJTX="ORDER DISCONTINUED" 71 S PSJOTMP=$G(P("OT")) S P("OT")="F" D EN1^PSJHL2(DFN,PSJCD,PSJORD,PSJTX) 72 Q 73 ; 74 7 ; Purge 75 N ND S ND=$S(ORPK["V":$P($G(^PS(55,+ORVP,"IV",+ORPK,0)),U,17)_U_$P($G(^(0)),U,3),1:$P($G(^PS(53.1,+ORPK,0)),U,9)_U_$P($G(^(2)),U,4)) 76 Q:"DE"'[$P(ND,U) S X1=+$P(ND,U,2),X2=30 D C^%DTC S ND=X D NOW^%DTC Q:ND>% 77 I ORPK["V",$D(^PS(55,+ORVP,"IV",+ORPK,0)) S $P(^(0),U,21)="" 78 I ORPK'["V",$D(^PS(53.1,+ORPK,0)) S $P(^(0),U,21)="" 79 S ORSTS="K" 80 Q 81 ; 82 8 ; Print 83 K DIR S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!'($D(ORPK)) S OREND=1 Q 84 S:'$G(PSIVUP) PSIVUP=+$$GTPCI^PSIVUTL S:'$D(PSIVAC) PSIVAC="OS" S (ON,ON55)=ORPK,DFN=+ORVP D @$S(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA("_DFN_","""_ON_""")"),ENDT^PSIVORV1 85 Q 86 ; 87 9 ; Release order (status=incomplete in 53.1, pending in 100) 88 S X=ORACTION I X=4!(X=6) D @ORACTION Q 89 Q:"36"[ORSTS N ON,PSJORIFN S PSJORIFN=ORIFN,ON=ORPK L +^PS(53.1,+ON):1 E D LOCKERR^PSIVORA1 Q 90 S Y=$G(^PS(53.1,+ON,0)),P("RES")=$P(Y,U,24),P("OLDON")=$P(Y,U,25) 91 N DA,DIE,DR,OREND S DR="28////P",DIE="^PS(53.1,",DA=+ON D ^DIE 92 I P("OLDON")]"" K DA,DIE,DR S DA=P("OLDON") D 93 .I DA["V" S DA(1)=+ORPV,DIE="^PS(55,"_DA(1)_",""IV"",",DR="114////"_+ON_"P"_";123////"_P("RES") 94 .E S DIE="^PS(53.1,",DR="105////"_ON_"P"_";107////"_P("RES") I P("RES")="E",$P($G(^PS(53.1,+P("OLDON"),0)),U,9)="D" S DR=DR_";28////DE" 95 .S DA=+DA L +@(DIE_DA_")"):1 E D LOCKERR^PSIVORA1 Q 96 .D ^DIE L -@(DIE_DA_")") 97 L -^PS(53.1,+ON) D DONE^PSIVORA1 98 Q 99 ; 100 10 ; Verify 101 Q 1 PSIVORA ;BIR/MLM-MAIN DRIVER FOR IV FLUIDS - OE/RR INTERFACE ;08 JAN 97 / 2:47 PM 2 ;;5.0; INPATIENT MEDICATIONS ;**29,41,110**;16 DEC 97 3 ; 4 ; Reference to ^PS(55 is supported by DBIA 2191 5 ; 6 EN ; Entry point called by IV Fluid protocol. 7 S X=ORACTION,PSIVAC="O"_$S(X=0:"N",X=1:"E",X=2:"R",X=4:"H",X=6:"D",X="8":"S",1:"") S:X'=5&(X'=7) PSIVUP=+$$GTPCI^PSIVUTL 8 S (PSGP,DFN)=+ORVP,PSJACNWP=1 D ^PSJAC I "578"[ORACTION D @ORACTION,DONE^PSIVORA1 Q 9 D ENCPP^PSIVOREN Q:'PSJIVORF!('PSJORF) D EN1,DONE^PSIVORA1 10 Q 11 ; 12 EN1 ; Take action on existing order. 13 S PSJORD=$G(ORPK) I ORGY>8 D @ORGY Q 14 I 'ORACTION D ^PSIVORFE Q 15 I '$G(ORPK) W !,"INSUFFICIENT INFORMATION, CANNOT CONTINUE." S OREND=1 Q 16 I ORPK["V",($P($G(^PS(55,DFN,"IV",+ORPK,0)),U,17)="O") D ONCALL^PSIVORV1 Q 17 I ORACTION<3 S P("FRES")=$S(ORPK["V":$P($G(^PS(55,DFN,"IV",+ORPK,2)),U,9),1:$P($G(^PS(53.1,+ORPK,0)),U,27)) I P("FRES")]"" D @$S(P("FRES")="R":"ALLREN^PSIVORV1",1:"ALLED^PSIVORV1") Q 18 S PSJORSTS=ORSTS,PSJORIFN=ORIFN L +@$S(PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD)",1:"^PS(53.1,+PSJORD)"):1 E D LOCKERR^PSIVORA1 Q 19 D @ORACTION L -@$S(PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD)",1:"^PS(53.1,+PSJORD)") 20 Q 21 ; 22 1 ; Edit an existing order. 23 D EDIT^PSIVORA1 24 Q 25 ; 26 2 ; Renew 27 D RENEW^PSIVORA1 28 Q 29 ; 30 3 ; Flag 31 Q 32 ; 33 4 ; Hold 34 I ORSTS'=3,ORSTS'=6 W !,$C(7),"Only ACTIVE orders may be placed on HOLD." S OREND=1 Q 35 S PSIVREA=$S(ORSTS=6:"H",1:"U"),ON55=PSJORD,$P(^PS(55,DFN,"IV",+ON55,0),U,10)=$S(PSIVREA="H":1,1:""),Y=$G(^PS(55,DFN,"IV",+ON55,0)),P(3)=$P(Y,U,3),P(17)=$P(Y,U,17) 36 D NOW^%DTC I ORSTS=3,P(3)<% S P(17)="E" D UPSTAT^PSIVOPT S ORSTS=7 W $C(7)," This order has expired." Q 37 S XED=0,PSIVALT=2,P(17)=$S(PSIVREA="H":"H",1:"A") D UPSTAT^PSIVOPT,LOG^PSIVORAL S ORSTS=$S(PSIVREA="H":3,1:6) 38 Q 39 ; 40 5 ; Event 41 N DA,DIE,DR,ON,P,PSIVACT,X 42 S ON=ORPK I ON["V" S X=$G(^PS(55,+ORVP,"IV",+ON,0)),P(3)=$P(X,U,3),P(17)=$P(X,U,17) 43 I ON'["V" S P(3)=$P($G(^PS(53.1,+ON,2)),U,4),P(17)=$P($G(^PS(53.1,+ON,0)),U,9) 44 Q:"AR"'[P(17) D NOW^%DTC Q:P(3)>% 45 I ON["V" S DR="100///E",DIE="^PS(55,"_+ORVP_",""IV"",",DA(1)=+ORVP 46 I ON'["V" S DR="28///E",DIE="^PS(53.1," 47 S PSIVACT=1,DA=+ON D ^DIE S ORSTS=7 48 Q 49 ; 50 6 ; Cancel - Delete pending or unreleased orders from Nonverified orders 51 ; (53.1) and Orders (100) files. 52 I ORSTS=1 W $C(7),!,"This order has already been DISCONTINUED." Q 53 I ORSTS=7 W $C(7),!,"Expired orders cannot be DISCONTINUED." Q 54 I PSJORD'["V",ORSTS=11 D Q 55 .S P("OLDON")=$P($G(^PS(53.1,+PSJORD,0)),U,25) I P("OLDON") D 56 ..I P("OLDON")["V",$D(^PS(55,DFN,"IV",+P("OLDON"),2)) S PSJRES=$P(^(2),U,9) S:PSJRES'="R" $P(^(2),U,6)="",$P(^(2),U,9)="" ;; D:PSJRES="R" ENBKOUT^PSJOREN(DFN,PSJORD) 57 ..I P("OLDON")'["V",$D(^PS(53.1,+P("OLDON"),0)) S PSJRES=$P(^(0),U,27) S:PSJRES'="R" $P(^(0),U,26,27)="^" I PSJRES="R" ;; D ENBKOUT^PSJOREN(DFN,PSJORD) 58 .K DA,DIK S DIK="^PS(53.1,",DA=+PSJORD D ^DIK S PSGP=DFN,X="P" D ENSK^PSGAXR K DA,DIK S ORIFN=PSJORIFN,ORSTS="K" Q 59 ; 60 DC ; DC order from Pharmacy complete function. 61 I PSJORD["V",'PSJCOM N PSIVREA S ON55=PSJORD,X=$G(^PS(55,DFN,"IV",+ON55,0)),P(3)=$P(X,U,3),P(17)=$P(X,U,17),PSIVREA="D",PSIVALT=2,PSIVALCK="STOP" D D^PSIVOPT2 D HL Q 62 I PSJORD["V",PSJCOM N PSIVREA S ON55=PSJORD,X=$G(^PS(55,DFN,"IV",+ON55,0)),P(3)=$P(X,U,3),P(17)=$P(X,U,17),PSIVREA="D",PSIVALT=2,PSIVALCK="STOP" D D^PSIVOPT2 Q 63 N DA,DR,DIE,PSJND S DA=+PSJORD,PSJND=$G(^PS(53.1,DA,0)),P("OLDON")=$P(PSJND,U,25),DIE="^PS(53.1,",DR="28///"_$S($P(PSJND,U,27)="E":"DE",1:"D") D ^DIE 64 D HL 65 Q 66 HL ; 67 Q:'$D(P("NAT")) 68 ;D EN1^PSJHL2(DFN,"OC",PSJORD,"ORDER CANCELED") 69 NEW PSJCD,PSJTX 70 I PSJORD["P" N PSJNOO S PSJCD="OC",PSJTX="ORDER CANCELED",PSJNOO=$G(P("NAT")) 71 E S PSJCD="OD",PSJTX="ORDER DISCONTINUED" 72 D EN1^PSJHL2(DFN,PSJCD,PSJORD,PSJTX) 73 ;D UNL^PSSLOCK(DFN,PSJORD) 74 Q 75 ; 76 7 ; Purge 77 N ND S ND=$S(ORPK["V":$P($G(^PS(55,+ORVP,"IV",+ORPK,0)),U,17)_U_$P($G(^(0)),U,3),1:$P($G(^PS(53.1,+ORPK,0)),U,9)_U_$P($G(^(2)),U,4)) 78 Q:"DE"'[$P(ND,U) S X1=+$P(ND,U,2),X2=30 D C^%DTC S ND=X D NOW^%DTC Q:ND>% 79 I ORPK["V",$D(^PS(55,+ORVP,"IV",+ORPK,0)) S $P(^(0),U,21)="" 80 I ORPK'["V",$D(^PS(53.1,+ORPK,0)) S $P(^(0),U,21)="" 81 S ORSTS="K" 82 Q 83 ; 84 8 ; Print 85 K DIR S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!'($D(ORPK)) S OREND=1 Q 86 S:'$G(PSIVUP) PSIVUP=+$$GTPCI^PSIVUTL S:'$D(PSIVAC) PSIVAC="OS" S (ON,ON55)=ORPK,DFN=+ORVP D @$S(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA("_DFN_","""_ON_""")"),ENDT^PSIVORV1 87 Q 88 ; 89 9 ; Release order (status=incomplete in 53.1, pending in 100) 90 S X=ORACTION I X=4!(X=6) D @ORACTION Q 91 Q:"36"[ORSTS N ON,PSJORIFN S PSJORIFN=ORIFN,ON=ORPK L +^PS(53.1,+ON):1 E D LOCKERR^PSIVORA1 Q 92 S Y=$G(^PS(53.1,+ON,0)),P("RES")=$P(Y,U,24),P("OLDON")=$P(Y,U,25) 93 N DA,DIE,DR,OREND S DR="28////P",DIE="^PS(53.1,",DA=+ON D ^DIE 94 I P("OLDON")]"" K DA,DIE,DR S DA=P("OLDON") D 95 .I DA["V" S DA(1)=+ORPV,DIE="^PS(55,"_DA(1)_",""IV"",",DR="114////"_+ON_"P"_";123////"_P("RES") 96 .E S DIE="^PS(53.1,",DR="105////"_ON_"P"_";107////"_P("RES") I P("RES")="E",$P($G(^PS(53.1,+P("OLDON"),0)),U,9)="D" S DR=DR_";28////DE" 97 .S DA=+DA L +@(DIE_DA_")"):1 E D LOCKERR^PSIVORA1 Q 98 .D ^DIE L -@(DIE_DA_")") 99 L -^PS(53.1,+ON) D DONE^PSIVORA1 100 Q 101 ; 102 10 ; Verify 103 Q
Note:
See TracChangeset
for help on using the changeset viewer.