| 1 | PSGOECS ;BIR/CML3-CANCEL SELECTED ORDERS ;02 Mar 99 / 9:29 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**23,29,44,58,81,110**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to FULL^VALM1 is supported by DBIA# 10116.
|
|---|
| 5 | ; Reference to ^PS(55 is supported by DBIA# 2191.
|
|---|
| 6 | ; Reference to ^PSSLOCK is supported by DBIA #2789.
|
|---|
| 7 | ;
|
|---|
| 8 | AM ;
|
|---|
| 9 | W !,"...marking ",$P(X,U),"..." S $P(^PS(55,PSGP,5,DA,4),"^",11,14)="^1^"_DUZ_"^"_PSGDT,PSGAL("C")=13040 W "." D ^PSGAL5 W "."
|
|---|
| 10 | I $D(PSJSYSO) S PSGORD=+PSGORD_"A",PSGPOSA="C",PSGPOSD=PSGDT D ENPOS^PSGVDS
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | NM ;
|
|---|
| 14 | W !,"...marking ",$P(X,U),"..." S $P(^PS(53.1,DA,4),"^",11,14)="^1^"_DUZ_"^"_PSGDT W "."
|
|---|
| 15 | I $D(PSJSYSO) S PSGORD=+PSGORD_"N",PSGPOSD=PSGDT,PSGPOSA="C" D ENPOS^PSGVDS
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | AC ; discontinue active order
|
|---|
| 19 | K DA S DA(1)=PSGP,DA=+PSGORD
|
|---|
| 20 | S X=$G(^PS(55,PSGP,5,DA,.2))
|
|---|
| 21 | I $P(X,U,4)="D" W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),U,1),!,"NO ACTION WAS TAKEN ON DONE ORDER",!,$C(7) HANG 1 Q
|
|---|
| 22 | NEW XX S XX=$P(^PS(55,PSGP,5,DA,0),U,9)
|
|---|
| 23 | I $S(XX="E":1,XX="D":1,XX="DE":1,1:0) W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),U,1),!,"NO ACTION WAS TAKEN ON "_$$CODES^PSIVUTL(XX,55.06,28)_" ORDER",!,$C(7) HANG 1 Q
|
|---|
| 24 | S X=$$DRUGNAME^PSJLMUTL(PSGP,PSGORD)
|
|---|
| 25 | I '$P(PSJSYSP0,"^",5) D AM Q
|
|---|
| 26 | W !,"...discontinuing ",$P(X,U),"...",! S PSGAL("C")=PSJSYSU*10+4000 D ^PSGAL5
|
|---|
| 27 | S PSGALR=20,DIE="^PS(55,"_PSGP_",5,",DR="28////D;Q;34////"_PSGDT_$S(PSJSYSU:"",1:";49////1"),DP=55.06,$P(^(2),"^",3)=$P(^PS(55,PSGP,5,DA,2),"^",4) D ^DIE S ^PS(55,"AUE",PSGP,DA)=""
|
|---|
| 28 | D EN1^PSJHL2(PSGP,"OD",PSGORD) S DA(1)=PSGP,DA=+PSGORD
|
|---|
| 29 | I PSJSYSL S $P(^PS(55,PSGP,5,DA,7),"^",1,2)=PSGDT_"^D",PSGTOL=2,PSGUOW=DUZ,PSGTOO=1 D ENL^PSGVDS
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | NC ; discontinue non-verifed order
|
|---|
| 33 | K DA S DA=+PSGORD,X=$G(^PS(53.1,DA,.2)),X=$$DRUGNAME^PSJLMUTL(PSGP,PSGORD)
|
|---|
| 34 | I $S($P(PSJSYSP0,"^",5):0,'$D(^PS(53.1,DA,4)):1,1:$P(^(4),"^",7)'=DUZ) D NM Q
|
|---|
| 35 | W !,"...discontinuing ",$P(X,U),"...",! S DIE="^PS(53.1,",DR="28////D"_$S(PSJSYSU:"",1:";42////1") D ^DIE
|
|---|
| 36 | D EN1^PSJHL2(PSGP,"OC",PSGORD)
|
|---|
| 37 | S DA=+PSGORD I PSJSYSL,PSJSYSL<3 S $P(^PS(53.1,DA,7),"^",1,2)=PSGDT_"^D",PSGTOO=2,PSGUOW=DUZ,PSGTOL=2 D ENL^PSGVDS
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | EN ; enter here
|
|---|
| 41 | I $G(PSJIVPRF) D ^PSIVSPDC Q ;Use for Speed DC in IV Order Profile
|
|---|
| 42 | D FULL^VALM1
|
|---|
| 43 | EN1 ;
|
|---|
| 44 | S (PSGONC,PSGLMT)=PSJOCNT,PSGONW="C" D ENWO^PSGON I "^"[X K X G RESET
|
|---|
| 45 | D NOW^%DTC S PSGDT=+$E(%,1,12)
|
|---|
| 46 | W ! F PSGOECS=1:1:PSGODDD F PSGOECS1=1:1 S PSGOECS2=$P(PSGODDD(PSGOECS),",",PSGOECS1) Q:'PSGOECS2 D
|
|---|
| 47 | .S PSGORD=^TMP("PSJON",$J,PSGOECS2) ; I $P($G(@($S((PSGORD["A")!(PSGORD["U"):"^PS(55,"_PSGP_",5,",(PSGORD["V"):"^PS(55,"_PSGP_",""IV"",",1:"^PS(53.1,")_(+PSGORD)_",0)")),"^",21) Q
|
|---|
| 48 | S PSJNOO=$$ENNOO^PSJUTL5("D") G:PSJNOO<0 EN1
|
|---|
| 49 | ;Prompt for requesting provider
|
|---|
| 50 | W ! I '$$REQPROV^PSGOEC G EN1
|
|---|
| 51 | W !
|
|---|
| 52 | ;
|
|---|
| 53 | ;F PSGOECS=1:1:PSGODDD F PSGOECS1=1:1 S PSGOECS2=$P(PSGODDD(PSGOECS),",",PSGOECS1) Q:'PSGOECS2 S (ON,PSGORD)=^TMP("PSJON",$J,PSGOECS2) D:(PSGORD["U") AC D:(PSGORD["P") NC D:(PSGORD["V") SPDCIV^PSIVSPDC
|
|---|
| 54 | ;Replaced above line with block structure below.
|
|---|
| 55 | N COMFLG,PSJCOM S (EXITLOOP,PSJCOM)=0
|
|---|
| 56 | F PSGOECS=1:1:PSGODDD D
|
|---|
| 57 | .F PSGOECS1=1:1 D Q:EXITLOOP=1
|
|---|
| 58 | ..S PSGOECS2=$P(PSGODDD(PSGOECS),",",PSGOECS1)
|
|---|
| 59 | ..I 'PSGOECS2 S EXITLOOP=1 Q
|
|---|
| 60 | ..S (ON,PSGORD)=^TMP("PSJON",$J,PSGOECS2)
|
|---|
| 61 | ..I PSGORD=+PSGORD D DCCOM Q
|
|---|
| 62 | ..I '$$LS^PSSLOCK(DFN,PSGORD) D Q
|
|---|
| 63 | ... W:PSGORD'["V" !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),"^",1),!,"NO ACTION WAS TAKEN",!,$C(7) HANG 1 Q
|
|---|
| 64 | ... W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D W !,"NO ACTION WAS TAKEN",!,$C(7) HANG 1
|
|---|
| 65 | ....F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X D
|
|---|
| 66 | .....W !,$G(PSJOC(ON,X))
|
|---|
| 67 | ..D CHKCOM I COMFLG D
|
|---|
| 68 | ... I PSGORD'["V" W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),"^",1),!,"NO ACTION WAS TAKEN",!,$C(7) HANG 1 Q
|
|---|
| 69 | ... W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D W !,"NO ACTION WAS TAKEN",!,$C(7) HANG 1
|
|---|
| 70 | ....F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X D
|
|---|
| 71 | .....W !,$G(PSJOC(ON,X))
|
|---|
| 72 | ..Q:PSJCOM
|
|---|
| 73 | ..D:(PSGORD["U") AC
|
|---|
| 74 | ..D:(PSGORD["P") NC
|
|---|
| 75 | ..D:(PSGORD["V") SPDCIV^PSIVSPDC
|
|---|
| 76 | ..; Call the unlock procedure
|
|---|
| 77 | ..D UNL^PSSLOCK(DFN,PSGORD)
|
|---|
| 78 | S X=""
|
|---|
| 79 | RESET ;
|
|---|
| 80 | I $G(PSGORD)["V" D INIT^PSJLMHED(3) S VALMBK="R" G DONE
|
|---|
| 81 | D INIT^PSJLMHED(1) S VALMBCK="R"
|
|---|
| 82 | ;
|
|---|
| 83 | DONE ;
|
|---|
| 84 | K DA,DIE,DP,DR,PSGAL,PSGALR,PSGLMT,PSGODDD,PSGOECS,PSGOECS1,PSGOECS2,PSGONW,PSGORD,PSGPOSA,PSGPOSD,PSGTOL,PSGTOO,PSGUOW,ORIFN,ORETURN,ORNATR
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | DCOR ; Create DC order/update stop date in OE/RR.
|
|---|
| 88 | S PSOC=$S(PSGORD["P":"OC",PSGORD["N":"OC",1:"OD")
|
|---|
| 89 | D EN1^PSJHL2(PSGP,PSOC,PSGORD)
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | ENOR ;
|
|---|
| 93 | K DA S PSGEDIT=$S($D(PSGEDIT):PSGEDIT,1:"D"),CF=1,PSGALR=20,DA=+PSGORD,T="" I PSGORD'["U",(PSGORD'["O") D:CF NSET^PSGOEC D NC^PSGOEC D ENOR2 G DONE^PSGOEC
|
|---|
| 94 | S DA(1)=PSGP D:CF ASET^PSGOEC D AC^PSGOEC
|
|---|
| 95 | G DONE^PSGOEC
|
|---|
| 96 | ;
|
|---|
| 97 | ENOR2 ;Check to see if order being DC'd is a Pending Renewal and is being DC'd due to edit.
|
|---|
| 98 | I PSGEDIT="DE",$P(^PS(53.1,+PSGORD,0),U,25),$P(^PS(53.1,+PSGORD,0),U,24)="R",PSGSD<$P($G(^PS(55,PSGP,5,+$P(^PS(53.1,+PSGORD,0),U,25),2)),U,4) D
|
|---|
| 99 | .K DA,DR S DA(1)=PSGP,DA=+$P(^PS(53.1,+PSGORD,0),U,25),DIE="^PS(55,"_PSGP_",5,",DR="34////"_PSGSD_";25////"_$P($G(^PS(55,PSGP,5,+$P(^PS(53.1,+PSGORD,0),U,25),2)),U,4)
|
|---|
| 100 | .D ^DIE,EN1^PSJHL2(PSGP,"XX",$P(^PS(53.1,+PSGORD,0),U,25))
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | CHKCOM ;Check to see if order is part of complex order series.
|
|---|
| 104 | S PSJCOM=$S(PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,.2)),U,8),PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,.2)),U,8),1:$P($G(^PS(53.1,+PSGORD,.2)),U,8)),COMFLG=0
|
|---|
| 105 | N PSJSTAT S PSJSTAT=$S(PSGORD["V":$P($G(^PS(55,PSGP,"IV",+PSGORD,0)),"^",17),PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,0)),"^",9),1:$P($G(^PS(53.1,+PSGORD,0)),"^",9))
|
|---|
| 106 | Q:'PSJCOM I "DE"[PSJSTAT Q
|
|---|
| 107 | W ! I PSGORD["V" N PSJLINE S PSJLINE=1 D DSPLORDV^PSJLMUT1(PSGP,PSGORD) D
|
|---|
| 108 | .F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X D
|
|---|
| 109 | ..W !,$G(PSJOC(ON,X))
|
|---|
| 110 | I PSGORD["U" W !,$P($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^",1) D
|
|---|
| 111 | .W !!,"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)
|
|---|
| 112 | F W !!,"Do you want to discontinue this series of complex orders" S %=1 D YN^DICN Q:%
|
|---|
| 113 | I %'=1 S COMFLG=1 Q
|
|---|
| 114 | 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 Q:COMFLG
|
|---|
| 115 | .Q:OO=PSGORD I '$$LS^PSSLOCK(DFN,OO) S COMFLG=1 Q
|
|---|
| 116 | Q:COMFLG
|
|---|
| 117 | 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
|
|---|
| 118 | .I (OO["U") N PSGORD S PSGORD=OO D AC
|
|---|
| 119 | .I (OO["V") N PSGORD S (ON,PSGORD)=OO D SPDCIV^PSIVSPDC
|
|---|
| 120 | .D UNL^PSSLOCK(DFN,PSGORD)
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | DCCOM ;DC pending/non-verified complex order
|
|---|
| 124 | I '$$LOCK^PSJOEA(DFN,PSGORD) W !,"Order # ",PSGOECS2," could not be discontinued.",!,$C(7) HANG 1 Q
|
|---|
| 125 | N PSGORD1 S PSGORD1=PSGORD
|
|---|
| 126 | N PSJO S PSJO=0 F S PSJO=$O(^PS(53.1,"ACX",PSGORD1,PSJO)) Q:'PSJO S PSGORD=PSJO_"P" D NC
|
|---|
| 127 | Q
|
|---|
