130 lines
8.9 KiB
Mathematica
130 lines
8.9 KiB
Mathematica
PSOAUTOC ;BIR/SAB - autocancel rxs on admission ;08/15/94
|
|
;;7.0;OUTPATIENT PHARMACY;**3,24,30,36,88,146,132,223,148,249**;DEC 1997;Build 9
|
|
;External reference to File #59.7 supported by DBIA 694
|
|
;External reference to File #55 supported by DBIA 2228
|
|
;External reference ^DPT(PSODFN,.1) supported by DBIA 10035
|
|
;External reference ^DGPM("AMV1" supported by DBIA 2249
|
|
;External reference ^DGPM("APTT1" supported by DBIA 2249
|
|
;External reference ^PSDRUG( supported by DBIA 221
|
|
;External reference ^PS(50.7 supported by DBIA 2223
|
|
AUTO I '$P(^PS(59.7,1,40.1),"^") W $C(7),!,"Autocancel System Parameter must be set to 'YES'",!,"before prescriptions are discontinued."
|
|
K %DT,DIC S DIC(0)="XZM",(DIE,DIC)="^DIC(19.2,",X="PSO AUTOCANCEL" D ^DIC
|
|
I +Y>0 D EDIT^XUTMOPT("PSO AUTOCANCEL") G EX
|
|
D RESCH^XUTMOPT("PSO AUTOCANCEL","","","24H","L"),EDIT^XUTMOPT("PSO AUTOCANCEL")
|
|
EX K Y,C,D,D0,DI,DQ,DA,DIE,DR,DIC,X
|
|
Q
|
|
TASK ;TaskMan entry point
|
|
G:'$P(^PS(59.7,1,40.1),"^") KILL S X="T-3" D ^%DT S PSOD2=Y,PSOD0=Y-.01,PSODL=Y+.3
|
|
S PSOD=PSOD0 F S PSOD=$O(^DGPM("AMV1",PSOD)),PSODFN=0 Q:'PSOD!(PSOD>PSODL) F PSODFN=0:0 S PSODFN=$O(^DGPM("AMV1",PSOD,PSODFN)) Q:'PSODFN I $G(^DPT(PSODFN,.1))]"",$O(^PS(55,PSODFN,"P",0)),'$O(^DGPM("APTT1",PSODFN,PSOD)) D CAN
|
|
G KILL
|
|
CAN ;discontinue Rxs
|
|
S DFN=PSODFN K VAIN D INP^VADPT I $P($G(VAIN(4)),"^"),$D(^PS(59.7,1,40.19,"B",$P($G(VAIN(4)),"^"))) Q
|
|
I $D(^PS(55,PSODFN,0)),$P($G(^PS(55,PSODFN,0)),U,6)'=2 D EN^PSOHLUP(PSODFN)
|
|
F PSORXJ=0:0 S PSORXJ=$O(^PS(55,PSODFN,"P",PSORXJ)) Q:'PSORXJ I $D(^(PSORXJ,0)) S PSORX=^(0) D
|
|
.I $D(^PSRX(PSORX,0)) S PSO0=^(0),PSO2=$G(^(2)),STA=+^("STA") I STA<11,PSO2,$P(PSO2,"^",6)'<DT,$E(PSO2,1,7)'>PSOD2!(STA=16) D
|
|
..S $P(^PSRX(PSORX,3),"^",5)=DT,$P(^("STA"),"^")=12
|
|
..D REVERSE^PSOBPSU1(PSORX,,"DC",7)
|
|
..D CAN^PSOTPCAN(PSORX)
|
|
..D FIL^PSOCAN3
|
|
..;remove from hold
|
|
..I $G(^PSRX(PSORX,"H"))]"" D
|
|
...K:$P(^PSRX(PSORX,"H"),"^") ^PSRX("AH",$P(^PSRX(PSORX,"H"),"^"),PSORX) S ^PSRX(PSORX,"H")=""
|
|
...I '$P($G(^PSRX(PSORX,2)),"^",2),$P($G(^(3)),"^") S $P(^PSRX(PSORX,2),"^",2)=$P(^(3),"^")
|
|
..;Add activity record
|
|
..S ACNT=0 F SUB=0:0 S SUB=$O(^PSRX(PSORX,"A",SUB)) Q:'SUB S ACNT=SUB
|
|
..S RFCNT=0 F RF=0:0 S RF=$O(^PSRX(PSORX,1,RF)) Q:'RF S RFCNT=RF S:RF>5 RFCNT=RF+1
|
|
..D NOW^%DTC S ACNT=ACNT+1,^PSRX(PSORX,"A",0)="^52.3DA^"_ACNT_"^"_ACNT S ^PSRX(PSORX,"A",ACNT,0)=%_"^"_"C"_"^^"_RFCNT_"^"_"Auto Discontinued on Admission"
|
|
..;delete from suspense
|
|
..D:$O(^PS(52.5,"B",PSORX,0))
|
|
...I $O(^PSRX(PSORX,1,0)) S DA=PSORX,SUSD=$P($G(^PS(52.5,$O(^PS(52.5,"B",PSORX,0)),0)),"^",2) D:'$G(^PS(52.5,$O(^PS(52.5,"B",PSORX,0)),"P")) REF^PSOCAN2
|
|
...S DA=$O(^PS(52.5,"B",PSORX,0)),DIK="^PS(52.5," D ^DIK K DIK
|
|
..;remove from non-verified file
|
|
..I $G(^PS(52.4,PSORX,0))]"" S DIK="^PS(52.4,",DA=PSORX D ^DIK K DIK
|
|
..S STAT="OD",PHARMST="",COM="Auto Discontinued on Admission" D EN^PSOHLSN1(PSORX,STAT,PHARMST,COM,"A")
|
|
;auto-dc pending orders
|
|
;F PSOIORD=0:0 S PSOIORD=$O(^PS(52.41,"AOR",PSODFN,PSOIORD)) Q:'PSOIORD F PSORD=0:0 S PSORD=$O(^PS(52.41,"AOR",PSODFN,PSOIORD,PSORD)) Q:'PSORD D
|
|
;.I $P(^PS(52.41,PSORD,0),"^",3)="RF" S DA=PSORD,DIK="^PS(52.41," D ^DIK K DA,DIK Q
|
|
;.K ^PS(52.41,"AOR",PSODFN,PSOIORD,PSORD) S $P(^PS(52.41,PSORD,0),"^",3)="DC"
|
|
;.D EN^PSOHLSN(+^PS(52.41,PSORD,0),"OC","Auto Canceled on Admission","A")
|
|
K PSORD,PSOIORD
|
|
Q
|
|
KILL K %,%H,%T,ACNT,DA,DFN,DIRUT,DTOUT,PSO,PSO0,PSO2,PSOD,PSOD0,PSOD2,PSODFN,PSODL,PSORX,PSORXJ,PSOSD,RF,RFCNT,SUB,TM,TSKDT,VAIN,X,X1,X2,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
|
|
K ORD,PHARMST,STAT,COM S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
SETUP ;initialize nightly Rx cost compile job
|
|
K %DT,DIC,DTOUT S DIC(0)="XZM",DIC="^DIC(19.2,",X="PSO COSTDAY NIGHTJOB" D ^DIC
|
|
I +Y>0 D EDIT^XUTMOPT("PSO COSTDAY NIGHTJOB") G OUT
|
|
D RESCH^XUTMOPT("PSO COSTDAY NIGHTJOB","","","24H","L"),EDIT^XUTMOPT("PSO COSTDAY NIGHTJOB")
|
|
OUT K Y,DIC,X,PSOTM,PSOOPTN,PSOPTN,%DT,DTOUT
|
|
Q
|
|
;initialize management data compile job
|
|
SETUP1 K %DT,DIC,DTOUT S DIC(0)="ZXM",DIC="^DIC(19.2,",X="PSO MGMT NIGHTLY COMPILE" D ^DIC
|
|
I +Y>0 D EDIT^XUTMOPT("PSO MGMT NIGHTLY COMPILE") G OUT
|
|
D RESCH^XUTMOPT("PSO MGMT NIGHTLY COMPILE","","","24H","L"),EDIT^XUTMOPT("PSO MGMT NIGHTLY COMPILE")
|
|
K Y,DIC,X,PSOTM,DIR,PSOOPTN,PSOPTN,%DT,DTOUT
|
|
Q
|
|
APSOD(PSODFN) ;sends mail message that date of death has been deleted
|
|
I $G(PSODFN),$D(^PS(52.91,PSODFN,0)) D
|
|
.I $P(^PS(52.91,PSODFN,0),"^",3),$P(^(0),"^",4)=5 D
|
|
..S $P(^PS(52.91,PSODFN,0),"^",3)="",$P(^PS(52.91,PSODFN,0),"^",4)=""
|
|
..S ^PS(52.91,"AX",DT,PSODFN)=""
|
|
..I $D(^PS(55,PSODFN,0)),$P($G(^PS(55,PSODFN,"PS")),"^")="" D
|
|
...N PSORESPS,PSORESFG,PSORESF1 S PSORESFG=0 F PSORESPS=0:0 S PSORESPS=$O(^PS(53,PSORESPS)) Q:'PSORESPS!(PSORESFG) D
|
|
....S PSORESF1=$P($G(^PS(53,PSORESPS,0)),"^") S PSORESF1=$$UP^XLFSTR(PSORESF1) I PSORESF1="NON-VA" S $P(^PS(55,PSODFN,"PS"),"^")=PSORESPS,PSORESFG=1
|
|
N DI,DA,DR,DIE,DIC,X,Y
|
|
S ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")="",ZTSAVE("PSODFN")="",ZTRTN="MAIL^PSOAUTOC",ZTDESC="Sends Mail Message that a Date of Death was Deleted",ZTIO="" D ^%ZTLOAD
|
|
Q
|
|
MAIL ;builds mail message
|
|
S DIC=2,DA=PSODFN,DR=.351,DIQ="PTDOD" D EN^DIQ1 I PTDOD(2,DA,.351)]"" G EX1
|
|
K ^TMP("PSOHLD",$J),^TMP("PSOAD",$J),TOTRX,TOTPRX
|
|
F I=0:0 S I=$O(^PSRX("APSOD",PSODFN,I)) Q:'I S TOTRX=$G(TOTRX)+1
|
|
F I=0:0 S I=$O(^PS(52.41,"APSOD",PSODFN,I)) Q:'I S TOTPRX=$G(TOTPRX)+1
|
|
F I=0:0 S I=$O(^PS(55,PSODFN,"NVA","APSOD",I)) Q:'I S TOTNVA=$G(TOTNVA)+1
|
|
K I Q:'$G(TOTRX)&('$G(TOTPRX))&('$G(TOTNVA))
|
|
S ENT=0,DFN=PSODFN D DEM^VADPT
|
|
S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=$P(^DPT(PSODFN,0),"^")_" ID#: "_VA("PID")_" DOB: "_$P(VADM(3),"^",2)
|
|
S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=" " S Y=DT D DD^%DT
|
|
S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="This patient had a Date of Death deleted on "_Y_"."
|
|
S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="When a Date of Death is entered ALL active prescriptions, pending orders, and",ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Non-VA Meds are discontinued automatically. The following Outpatient"
|
|
S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Prescriptions and/or Pending Orders should be reviewed for this patient using",ENT=ENT+1,^TMP("PSOAD",$J,ENT)="the Patient Prescription Processing option."
|
|
S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=" "
|
|
I $G(TOTRX) S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Total number of Prescriptions found for review is "_TOTRX D
|
|
.F I=0:0 S I=$O(^PSRX("APSOD",PSODFN,I)) Q:'I S ^TMP("PSOHLD",$J,$P(^PSDRUG($P(^PSRX(I,0),"^",6),0),"^"),I)=I
|
|
.S DRG="" F S DRG=$O(^TMP("PSOHLD",$J,DRG)) Q:DRG="" F I=0:0 S I=$O(^TMP("PSOHLD",$J,DRG,I)) Q:'I S RX=^TMP("PSOHLD",$J,DRG,I) D
|
|
..S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Rx: "_$P(^PSRX(RX,0),"^")_" Drug: "_DRG
|
|
N PSOLPI,PSOLPIX,PSOLPIST,PSOLPND
|
|
I $G(TOTPRX) S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=" " D
|
|
.S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Total number of Pending Orders found and reinstated is "_TOTPRX
|
|
.F PSOLPI=0:0 S PSOLPI=$O(^PS(52.41,"APSOD",PSODFN,PSOLPI)) Q:'PSOLPI D
|
|
..S $P(^PS(52.41,PSOLPI,0),"^",3)=$P(^PS(52.41,PSOLPI,"DDSTA"),";"),^PS(52.41,"AOR",PSODFN,$P(^PS(52.41,PSOLPI,"DDSTA"),";",2),PSOLPI)=""
|
|
..S PSOLPIX=$P($G(^PS(52.41,PSOLPI,0)),"^"),PSOLPIST=$P($G(^(0)),"^",3)
|
|
..I PSOLPIX D
|
|
...I PSOLPIST'="NW",PSOLPIST'="RNW",PSOLPIST'="RF" Q
|
|
...;Reset remaining cross references
|
|
...S PSOLPND=$G(^PS(52.41,PSOLPI,0))
|
|
...I $P(PSOLPND,"^",12),$P(PSOLPND,"^",13) S ^PS(52.41,"ACL",$P(PSOLPND,"^",13),$P(PSOLPND,"^",12),PSOLPI)=""
|
|
...I $P(^PS(52.41,PSOLPI,"INI"),"^"),$P(PSOLPND,"^",12) S ^PS(52.41,"AD",$P(PSOLPND,"^",12),$P(^PS(52.41,PSOLPI,"INI"),"^"),PSOLPI)=""
|
|
...I PSOLPIST="RNW",$P(PSOLPND,"^",21) S ^PS(52.41,"AQ",$P(PSOLPND,"^",21),PSOLPI)=""
|
|
...I PSOLPIST="RF" Q
|
|
...;Update CPRS with Pending order information on new and renewals
|
|
...D EN^PSOHLSN(PSOLPIX,"SC","IP")
|
|
..K ^PS(52.41,"APSOD",PSODFN,PSOLPI),ORTYP
|
|
..S ENT=ENT+1,ORTYP=$P(^PS(52.41,PSOLPI,0),"^",3)
|
|
..S MED=$S($P(^PS(52.41,PSOLPI,0),"^",9):$P(^PSDRUG($P(^PS(52.41,PSOLPI,0),"^",9),0),"^"),1:$P(^PS(50.7,$P(^PS(52.41,PSOLPI,0),"^",8),0),"^"))
|
|
..I $G(MED)']"" S MED="NO DRUG OR ORDERABLE ITEM FOUND"
|
|
..S ^TMP("PSOAD",$J,ENT)=$S(ORTYP="RF":"Refill",ORTYP="RNW":"Renew",ORTYP="HD":"On Hold",1:"New")_" Order Request - "
|
|
..S ^TMP("PSOAD",$J,ENT)=^TMP("PSOAD",$J,ENT)_"Medication: "_MED
|
|
I $G(TOTNVA) S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=" " D
|
|
.N PSODD,MED,PSOOI,PSONVA,NVA S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Total number of Non-VA Med Orders found and reinstated is "_TOTNVA
|
|
.F NVA=0:0 S NVA=$O(^PS(55,PSODFN,"NVA","APSOD",NVA)) Q:'NVA D
|
|
..S PSOOI=$P(^PS(55,PSODFN,"NVA",NVA,0),"^"),PSODD=$P(^(0),"^",2),PLACER=$P(^(0),"^",8),LOCATION=$P(^(0),"^",12),DFN=PSODFN
|
|
..S MED=$S(PSODD:$P($G(^PSDRUG(PSODD,0)),"^"),1:$P(^PS(50.7,+PSOOI,0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,+PSOOI,0),"^",2),0),"^"))
|
|
..S $P(^PS(55,PSODFN,"NVA",NVA,0),"^",6)="",$P(^(0),"^",7)="" K ^PS(55,PSODFN,"NVA","APSOD",NVA)
|
|
..S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Non-VA "_MED,REIN=1,PSONVA=NVA D REIN^PSONVNEW
|
|
..K PSOOI,PSODD,PLACER,LOCATION,MED,REIN
|
|
S XMDUZ=.5,XMSUB="Date of Death Deleted for "_$P(^DPT(PSODFN,0),"^")_" ("_VA("BID")_")",XMTEXT="^TMP(""PSOAD"",$J," N DIFROM
|
|
F I=0:0 S I=$O(^XUSEC("PSORPH",I)) Q:'I S XMY(I)=""
|
|
D ^XMD
|
|
EX1 K ^TMP("PSOHLD",$J),XMSUB,XMTEXT,XMY,XMDUZ,^TMP("PSOAD",$J),I,TOTRX,TOTPRX,PSODFN,ENT,ORTYP,X,Y,MED,RX,PTDOD
|
|
Q
|