| 1 | PSGOEC ;BIR/CML3-CANCEL ORDERS ;02 Mar 99 / 9:29 AM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**23,58,110,175**;16 DEC 97;Build 18
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^PS(55 is supported by DBIA# 2191.
|
---|
| 5 | ; Reference to ^PSSLOCK is supported by DBIA 2789.
|
---|
| 6 | ;
|
---|
| 7 | ENA ; all orders
|
---|
| 8 | D ENCV^PSGSETU Q:$D(XQUIT) S CF=$P(PSJSYSP0,U,5) N ND,ND1 S ND="$D(^PS(55,PSGP,5,PSGDA,4)),$P(^(4),U,12),$P(^(4),U,13)",ND1="$D(^PS(53.1,PSGDA,4)),$P(^(4),U,12),$P(^(4),U,13)"
|
---|
| 9 | F W !!,"Do you want to ",$S(CF:"discontinue",1:"mark for discontinuation")," all of this patient's orders" S %=1 D YN^DICN Q:% D ENCAM^PSGOEM
|
---|
| 10 | S PSGCF=0 Q:%<0 S PSGCF=1,T=$E("T",'PSJSYSU) G:%=1 ENCA F T=0:0 S T=$O(^PS(55,PSGP,5,"AUS",T)) Q:'T F PSGDA=0:0 S PSGDA=$O(^PS(55,PSGP,5,"AUS",T,PSGDA)) Q:'PSGDA I @ND Q
|
---|
| 11 | E F PSGDA=0:0 S PSGDA=$O(^PS(53.1,"AC",PSGP,PSGDA)) Q:'PSGDA I @ND1 Q
|
---|
| 12 | E G DONE
|
---|
| 13 | W !!,"SOME OR ALL OF THESE ORDERS HAVE" D ENUMK^PSGOEM Q:%'=1
|
---|
| 14 | W !!,"...a few moments, please..." S PSGAL("C")=PSJSYSU*10+21400
|
---|
| 15 | F T=PSGDT:0 S T=$O(^PS(55,PSGP,5,"AUS",T)) Q:'T F PSGDA=0:0 S PSGDA=$O(^PS(55,PSGP,5,"AUS",T,PSGDA)) Q:'PSGDA I @ND W "." D RS,^PSGAL5
|
---|
| 16 | F PSGDA=0:0 S PSGDA=$O(^PS(53.1,"AC",PSGP,PSGDA)) Q:'PSGDA I @ND1 W "." D RS
|
---|
| 17 | W " . . . DONE!" G DONE
|
---|
| 18 | ENCA ;
|
---|
| 19 | D NOW^%DTC S (Q1,PSGDT)=+$E(%,1,12) F S Q1=$O(^PS(55,PSGP,5,"AUS",Q1)) Q:'Q1 F Q2=0:0 S Q2=$O(^PS(55,PSGP,5,"AUS",Q1,Q2)) Q:'Q2 I $P($G(^PS(55,PSGP,5,Q2,0)),"^",21) Q
|
---|
| 20 | E F Q2=0:0 S Q2=$O(^PS(53.1,"AC",PSGP,Q2)) Q:'Q2 I $P($G(^PS(53.1,Q2,0)),U,21) Q
|
---|
| 21 | I S PSJNOO=$$ENNOO^PSJUTL5("D") I PSJNOO<0!('$$REQPROV) D G DONE
|
---|
| 22 | .W !!,$C(7),"No changes made to this order." D PAUSE^VALM1
|
---|
| 23 | S PSGALR=$S('$D(PSGALO):20,PSGALO?4N&($E(PSGALO)=1):10,1:20) I $P(PSJSYSP0,U,5) D ENHE^PSJADT0 S PSGOP=PSGP D ASET
|
---|
| 24 | F SD=PSGDT:0 S SD=$O(^PS(55,PSGP,5,"AUS",SD)) Q:'SD F PSGORD=0:0 S PSGORD=$O(^PS(55,PSGP,5,"AUS",SD,PSGORD)) Q:'PSGORD S PSGORD=+PSGORD_"A" D AC
|
---|
| 25 | D NSET S CF=$P(PSJSYSP0,U,5) F PSGORD=0:0 S PSGORD=$O(^PS(53.1,"AC",PSGP,PSGORD)) Q:'PSGORD S PSGORD=+PSGORD_"N" D NC
|
---|
| 26 | W " . . . DONE!" K PSGORD G DONE
|
---|
| 27 | ENO(PSGP,PSGORD) ; single order
|
---|
| 28 | I PSGSTAT="D" W !,"This order has already been DISCONTINUED." D PAUSE^VALM1 Q
|
---|
| 29 | S CF=$S($P(PSJSYSP0,U,5):1,PSGORD["U":0,1:($P($G(^PS(53.1,+PSGORD,0)),U,25)=""&($P($G(^(4)),U,7)=DUZ)))
|
---|
| 30 | S PSJCOM=+$S(PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,.2)),"^",8),1:$P($G(^PS(53.1,+PSGORD,.2)),"^",8))
|
---|
| 31 | I 'CF,PSJCOM W !!,"This order is part of a complex order and CANNOT be marked for discontinuation." Q
|
---|
| 32 | I PSJCOM W !!,"This order is part of a complex order. If you discontinue this order the",!,"following orders will be discontinued too (unless the stop date has already",!,"been reached)." D CMPLX^PSJCOM1(PSGP,PSJCOM,PSGORD)
|
---|
| 33 | F W !!,"Do you want to ",$S(PSJCOM:"discontinue this series of complex orders",CF:"discontinue this order",1:"mark this order for discontinuation") S %=1 D YN^DICN Q:% D ENCOM^PSGOEM
|
---|
| 34 | I %<0 S VALMBCK="" Q
|
---|
| 35 | G:%=1 SOC I $S(PSGORD["U":$D(^PS(55,PSGP,5,+PSGORD,4)),1:$D(^PS(53.1,+PSGORD,4))),$P(^(4),U,12) W !!,"THIS ORDER HAS"
|
---|
| 36 | I D ENUMK^PSGOEM I %=1 W "..." K DA S:PSGORD["A" PSGAL("C")=PSJSYSU*10+21400,DA=+PSGORD,DA(1)=PSGP D RS,^PSGAL5:PSGORD["A" W " . . . DONE!"
|
---|
| 37 | G DONE
|
---|
| 38 | SOC ;
|
---|
| 39 | I 'CF,'$P($S(PSGORD["U":$G(^PS(55,PSGP,5,+PSGORD,0)),1:$G(^PS(53.1,+PSGORD,0))),U,21) W !!,"...one moment, please..."
|
---|
| 40 | E I CF S PSJNOO=$$ENNOO^PSJUTL5("D") I PSJNOO<0 D ABORT^PSGOEE G DONE
|
---|
| 41 | ; prompt for requesting provider
|
---|
| 42 | I CF,'$$REQPROV D ABORT^PSGOEE G DONE
|
---|
| 43 | K DA D NOW^%DTC S PSGDT=%,T=$E("T",'PSJSYSU),PSGALR=20,DA=+PSGORD,DA(1)=PSGP
|
---|
| 44 | I 'PSJCOM D
|
---|
| 45 | .I PSGORD["U" D ASET:CF,AC
|
---|
| 46 | .I PSGORD'["U" D NSET:CF,NC
|
---|
| 47 | I PSJCOM N COMFLG S COMFLG=0 D
|
---|
| 48 | . I PSGORD["P" Q:('$$LOCK^PSJOEA(PSGP,PSJCOM)) D
|
---|
| 49 | .. N O S O="" F S O=$O(^PS(53.1,"ACX",PSJCOM,O)) Q:O="" S (PSGORD,PSJORD)=O_"P" D NSET,NC
|
---|
| 50 | .I PSGORD["U" N O,OO S O=0,OO="" F S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O F S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO="" Q:COMFLG D
|
---|
| 51 | .. Q:OO=PSGORD I '$$LS^PSSLOCK(DFN,OO) S COMFLG=1 Q
|
---|
| 52 | I PSJCOM Q:COMFLG N O,OO S O=0,OO="" F S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O F S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO="" D
|
---|
| 53 | . I OO["V" S ON55=OO D D1^PSIVOPT2 S PSIVALT=1,PSIVALCK="STOP",PSIVREA="D",ON=ON55,P(3)=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3) D
|
---|
| 54 | .. D LOG^PSIVORAL N PSJORD S PSJORD=ON55,P(3)=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3),P("NAT")=PSJNOO D HL^PSIVORA
|
---|
| 55 | . I OO["U" N PSGORD,PSJORD S (PSGORD,PSJORD)=OO D ASET^PSGOEC,AC^PSGOEC
|
---|
| 56 | Q
|
---|
| 57 | D1 N %,DA,DIE,DIU,STP,NSTOP
|
---|
| 58 | D NOW^%DTC S NSTOP=+$E(%,1,12),STP=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3),NSTOP=+$S(STP>NSTOP:NSTOP,1:STP),P(17)="D"
|
---|
| 59 | S DA(1)=DFN,DA=+ON55,DIE="^PS(55,"_DFN_",""IV"",",DR="109////"_NSTOP_$S('$P($G(^PS(55,DFN,"IV",+ON55,2)),U,7):";116////"_STP,1:"")_";100///D;.03////"_NSTOP,PSIVACT=1 D ^DIE
|
---|
| 60 | I $S($G(PSIVAC)="OD":0,$G(PSIVAC)'="AD":1,$G(PSGALO)<1060:0,1:$P($G(PSJSYSW0),U,15)) S X=$S($G(PSIVAC)="AD":1,1:2) D ENLBL^PSIVOPT(X,$S(X=1:+$G(PSGUOW),1:DUZ),DFN,3,+ON55,$E("AD",1,3-X))
|
---|
| 61 | D:'$D(PSJIVORF) ORPARM^PSIVOREN Q:'PSJIVORF ;* S ORIFN=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,21) Q:'ORIFN
|
---|
| 62 | Q
|
---|
| 63 | OUT ;
|
---|
| 64 | W $S(PSJCOM:"...ORDER ",1:"...ORDERS "),$S(CF:"DISCONTINUED!",1:"MARKED!") S PSGCANFL=1
|
---|
| 65 | DONE ;
|
---|
| 66 | K CF,DA,DIE,DP,DR,ORIFN,ORETURN,PSGAL,PSGALR,PSGDA,SD,ST,T,UCF,Y Q
|
---|
| 67 | ASET ;
|
---|
| 68 | S DIE="^PS(55,"_PSGP_",5,",DR="28////"_$S($P($G(^PS(55,PSGP,5,+$G(PSJORD),0)),U,27)="E":"DE",$D(PSGEDIT):"DE",1:"D")_";Q;34////"_PSGDT_$S(T]"":";49////1",1:"")
|
---|
| 69 | Q
|
---|
| 70 | NSET ;
|
---|
| 71 | S DIE="^PS(53.1,",DR="28////"_$S($P($G(^PS(53.1,+$G(PSJORD),0)),U,27)="E":"DE",$D(PSGEDIT):"DE",1:"D")_$S(T]"":";42////1",1:"")_";25////"_PSGDT Q
|
---|
| 72 | AC ;
|
---|
| 73 | I 'CF K DA S $P(^PS(55,PSGP,5,+PSGORD,4),U,11,14)="^1^"_DUZ_U_PSGDT,PSGAL("C")=13040,DA=+PSGORD,DA(1)=PSGP D ^PSGAL5
|
---|
| 74 | I 'CF,$D(PSJSYSO) S PSGORD=+PSGORD_"A",PSGPOSA="C",PSGPOSD=PSGDT D ENPOS^PSGVDS
|
---|
| 75 | Q:'CF K DA,ORIFN S PSGAL("C")=PSJSYSU*10+4000,DA=+PSGORD,DA(1)=PSGP D ^PSGAL5 S $P(^(2),U,3)=$P(^PS(55,PSGP,5,+PSGORD,2),U,4) D ^DIE S ^PS(55,"AUE",PSGP,+PSGORD)=""
|
---|
| 76 | I PSJSYSL K DA S $P(^PS(55,PSGP,5,+PSGORD,7),U,1,2)=PSGDT_U_$S($D(PSGEDIT):"DE",1:"D"),PSGTOL=2,PSGUOW=DUZ,PSGTOO=1,DA=+PSGORD,DA(1)=PSGP D ENL^PSGVDS
|
---|
| 77 | S ORIFN=$P($G(^PS(55,PSGP,5,+PSGORD,0)),U,21) D:ORIFN DCOR^PSGOECS
|
---|
| 78 | Q
|
---|
| 79 | NC ;
|
---|
| 80 | I 'CF S $P(^PS(53.1,+PSGORD,4),"^",11,14)="^1^"_DUZ_U_PSGDT
|
---|
| 81 | I 'CF,$D(PSJSYSO) S PSGORD=+PSGORD_"N",PSGPOSA="C",PSGPOSD=PSGDT D ENPOS^PSGVDS
|
---|
| 82 | Q:'CF S PSGSTAT=$P($G(^PS(53.1,+PSGORD,0)),U,9),PSGORIFN=$P($G(^(0)),U,21)
|
---|
| 83 | I PSGSTAT'="U" K DA,ORIFN S DA=+PSGORD D ^DIE I PSJSYSL,PSJSYSL<3,(PSGSTAT'="P") S $P(^PS(53.1,+PSGORD,7),U,1,2)=PSGDT_U_$S($D(PSGEDIT):"DE",1:"D"),PSGTOO=2,PSGUOW=DUZ,PSGTOL=2 D ENL^PSGVDS
|
---|
| 84 | I PSGSTAT="U" K DA S DA=+PSGORD,DIK="^PS(53.1," D ^DIK
|
---|
| 85 | I PSGORIFN S ORIFN=PSGORIFN D DCOR^PSGOECS
|
---|
| 86 | Q
|
---|
| 87 | T ;
|
---|
| 88 | F W !!,"Is this due to the patient being transferred" S %=2 D YN^DICN Q:% D ENCTM^PSGOEM1
|
---|
| 89 | S T=$S(%<0:"^",1:$E("T",%=1)) Q
|
---|
| 90 | RS ;
|
---|
| 91 | ; naked ref below is from variable ND1, ^PS(53.1,PSGDA,4)
|
---|
| 92 | S $P(^(4),U,11,14)="^^^" Q
|
---|
| 93 | ;
|
---|
| 94 | REQPROV() ;
|
---|
| 95 | K PSJDCPRV,DIC,DUOUT,DTOUT,Y
|
---|
| 96 | N PROVIDER,PROVNAME,RESULT,RSB S RESULT=0
|
---|
| 97 | S PROVIDER=+$P($G(^PS(55,DFN,5.1)),"^",2),PROVNAME=""
|
---|
| 98 | I $G(PSJRQPND) S PROVIDER=0
|
---|
| 99 | I PROVIDER>0 D
|
---|
| 100 | .S DIC=200,DR="53.1;53.4",DIQ="RSB",DIQ(0)="I",DA=PROVIDER D EN^DIQ1
|
---|
| 101 | .K DIC,DR,DA,DIQ
|
---|
| 102 | .I $G(RSB(200,PROVIDER,53.1,"I"))="1"&(($G(RSB(200,PROVIDER,53.4,"I"))="")!($G(RSB(200,PROVIDER,53.4,"I"))>DT)) D
|
---|
| 103 | ..S DIC=200,DA=PROVIDER,DR=".01",DIQ="RSB",DIQ(0)="E" D EN^DIQ1
|
---|
| 104 | ..S PROVNAME=$G(RSB(200,PROVIDER,.01,"E")) K DA,DIQ,DR
|
---|
| 105 | K DIC S DIC=200,DIC(0)="AEMQZ"
|
---|
| 106 | S:PROVNAME]"" DIC("B")=PROVNAME
|
---|
| 107 | S DIC("A")="Requesting PROVIDER: "
|
---|
| 108 | S DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)>DT)" D ^DIC K DIC
|
---|
| 109 | I +Y>0,'$D(DUOUT),'$D(DTOUT) S RESULT=1,PSJDCPRV=+Y
|
---|
| 110 | Q RESULT
|
---|