source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOAUTOC.m@ 1328

Last change on this file since 1328 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1PSOAUTOC ;BIR/SAB - autocancel rxs on admission ;08/15/94
2 ;;7.0;OUTPATIENT PHARMACY;**3,24,30,36,88,146,132,223,148,249**;DEC 1997;Build 9
3 ;External reference to File #59.7 supported by DBIA 694
4 ;External reference to File #55 supported by DBIA 2228
5 ;External reference ^DPT(PSODFN,.1) supported by DBIA 10035
6 ;External reference ^DGPM("AMV1" supported by DBIA 2249
7 ;External reference ^DGPM("APTT1" supported by DBIA 2249
8 ;External reference ^PSDRUG( supported by DBIA 221
9 ;External reference ^PS(50.7 supported by DBIA 2223
10AUTO I '$P(^PS(59.7,1,40.1),"^") W $C(7),!,"Autocancel System Parameter must be set to 'YES'",!,"before prescriptions are discontinued."
11 K %DT,DIC S DIC(0)="XZM",(DIE,DIC)="^DIC(19.2,",X="PSO AUTOCANCEL" D ^DIC
12 I +Y>0 D EDIT^XUTMOPT("PSO AUTOCANCEL") G EX
13 D RESCH^XUTMOPT("PSO AUTOCANCEL","","","24H","L"),EDIT^XUTMOPT("PSO AUTOCANCEL")
14EX K Y,C,D,D0,DI,DQ,DA,DIE,DR,DIC,X
15 Q
16TASK ;TaskMan entry point
17 G:'$P(^PS(59.7,1,40.1),"^") KILL S X="T-3" D ^%DT S PSOD2=Y,PSOD0=Y-.01,PSODL=Y+.3
18 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
19 G KILL
20CAN ;discontinue Rxs
21 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
22 I $D(^PS(55,PSODFN,0)),$P($G(^PS(55,PSODFN,0)),U,6)'=2 D EN^PSOHLUP(PSODFN)
23 F PSORXJ=0:0 S PSORXJ=$O(^PS(55,PSODFN,"P",PSORXJ)) Q:'PSORXJ I $D(^(PSORXJ,0)) S PSORX=^(0) D
24 .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
25 ..S $P(^PSRX(PSORX,3),"^",5)=DT,$P(^("STA"),"^")=12
26 ..D REVERSE^PSOBPSU1(PSORX,,"DC",7)
27 ..D CAN^PSOTPCAN(PSORX)
28 ..D FIL^PSOCAN3
29 ..;remove from hold
30 ..I $G(^PSRX(PSORX,"H"))]"" D
31 ...K:$P(^PSRX(PSORX,"H"),"^") ^PSRX("AH",$P(^PSRX(PSORX,"H"),"^"),PSORX) S ^PSRX(PSORX,"H")=""
32 ...I '$P($G(^PSRX(PSORX,2)),"^",2),$P($G(^(3)),"^") S $P(^PSRX(PSORX,2),"^",2)=$P(^(3),"^")
33 ..;Add activity record
34 ..S ACNT=0 F SUB=0:0 S SUB=$O(^PSRX(PSORX,"A",SUB)) Q:'SUB S ACNT=SUB
35 ..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
36 ..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"
37 ..;delete from suspense
38 ..D:$O(^PS(52.5,"B",PSORX,0))
39 ...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
40 ...S DA=$O(^PS(52.5,"B",PSORX,0)),DIK="^PS(52.5," D ^DIK K DIK
41 ..;remove from non-verified file
42 ..I $G(^PS(52.4,PSORX,0))]"" S DIK="^PS(52.4,",DA=PSORX D ^DIK K DIK
43 ..S STAT="OD",PHARMST="",COM="Auto Discontinued on Admission" D EN^PSOHLSN1(PSORX,STAT,PHARMST,COM,"A")
44 ;auto-dc pending orders
45 ;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
46 ;.I $P(^PS(52.41,PSORD,0),"^",3)="RF" S DA=PSORD,DIK="^PS(52.41," D ^DIK K DA,DIK Q
47 ;.K ^PS(52.41,"AOR",PSODFN,PSOIORD,PSORD) S $P(^PS(52.41,PSORD,0),"^",3)="DC"
48 ;.D EN^PSOHLSN(+^PS(52.41,PSORD,0),"OC","Auto Canceled on Admission","A")
49 K PSORD,PSOIORD
50 Q
51KILL 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
52 K ORD,PHARMST,STAT,COM S:$D(ZTQUEUED) ZTREQ="@"
53 Q
54SETUP ;initialize nightly Rx cost compile job
55 K %DT,DIC,DTOUT S DIC(0)="XZM",DIC="^DIC(19.2,",X="PSO COSTDAY NIGHTJOB" D ^DIC
56 I +Y>0 D EDIT^XUTMOPT("PSO COSTDAY NIGHTJOB") G OUT
57 D RESCH^XUTMOPT("PSO COSTDAY NIGHTJOB","","","24H","L"),EDIT^XUTMOPT("PSO COSTDAY NIGHTJOB")
58OUT K Y,DIC,X,PSOTM,PSOOPTN,PSOPTN,%DT,DTOUT
59 Q
60 ;initialize management data compile job
61SETUP1 K %DT,DIC,DTOUT S DIC(0)="ZXM",DIC="^DIC(19.2,",X="PSO MGMT NIGHTLY COMPILE" D ^DIC
62 I +Y>0 D EDIT^XUTMOPT("PSO MGMT NIGHTLY COMPILE") G OUT
63 D RESCH^XUTMOPT("PSO MGMT NIGHTLY COMPILE","","","24H","L"),EDIT^XUTMOPT("PSO MGMT NIGHTLY COMPILE")
64 K Y,DIC,X,PSOTM,DIR,PSOOPTN,PSOPTN,%DT,DTOUT
65 Q
66APSOD(PSODFN) ;sends mail message that date of death has been deleted
67 I $G(PSODFN),$D(^PS(52.91,PSODFN,0)) D
68 .I $P(^PS(52.91,PSODFN,0),"^",3),$P(^(0),"^",4)=5 D
69 ..S $P(^PS(52.91,PSODFN,0),"^",3)="",$P(^PS(52.91,PSODFN,0),"^",4)=""
70 ..S ^PS(52.91,"AX",DT,PSODFN)=""
71 ..I $D(^PS(55,PSODFN,0)),$P($G(^PS(55,PSODFN,"PS")),"^")="" D
72 ...N PSORESPS,PSORESFG,PSORESF1 S PSORESFG=0 F PSORESPS=0:0 S PSORESPS=$O(^PS(53,PSORESPS)) Q:'PSORESPS!(PSORESFG) D
73 ....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
74 N DI,DA,DR,DIE,DIC,X,Y
75 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
76 Q
77MAIL ;builds mail message
78 S DIC=2,DA=PSODFN,DR=.351,DIQ="PTDOD" D EN^DIQ1 I PTDOD(2,DA,.351)]"" G EX1
79 K ^TMP("PSOHLD",$J),^TMP("PSOAD",$J),TOTRX,TOTPRX
80 F I=0:0 S I=$O(^PSRX("APSOD",PSODFN,I)) Q:'I S TOTRX=$G(TOTRX)+1
81 F I=0:0 S I=$O(^PS(52.41,"APSOD",PSODFN,I)) Q:'I S TOTPRX=$G(TOTPRX)+1
82 F I=0:0 S I=$O(^PS(55,PSODFN,"NVA","APSOD",I)) Q:'I S TOTNVA=$G(TOTNVA)+1
83 K I Q:'$G(TOTRX)&('$G(TOTPRX))&('$G(TOTNVA))
84 S ENT=0,DFN=PSODFN D DEM^VADPT
85 S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=$P(^DPT(PSODFN,0),"^")_" ID#: "_VA("PID")_" DOB: "_$P(VADM(3),"^",2)
86 S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=" " S Y=DT D DD^%DT
87 S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="This patient had a Date of Death deleted on "_Y_"."
88 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"
89 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."
90 S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=" "
91 I $G(TOTRX) S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Total number of Prescriptions found for review is "_TOTRX D
92 .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
93 .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
94 ..S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Rx: "_$P(^PSRX(RX,0),"^")_" Drug: "_DRG
95 N PSOLPI,PSOLPIX,PSOLPIST,PSOLPND
96 I $G(TOTPRX) S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=" " D
97 .S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Total number of Pending Orders found and reinstated is "_TOTPRX
98 .F PSOLPI=0:0 S PSOLPI=$O(^PS(52.41,"APSOD",PSODFN,PSOLPI)) Q:'PSOLPI D
99 ..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)=""
100 ..S PSOLPIX=$P($G(^PS(52.41,PSOLPI,0)),"^"),PSOLPIST=$P($G(^(0)),"^",3)
101 ..I PSOLPIX D
102 ...I PSOLPIST'="NW",PSOLPIST'="RNW",PSOLPIST'="RF" Q
103 ...;Reset remaining cross references
104 ...S PSOLPND=$G(^PS(52.41,PSOLPI,0))
105 ...I $P(PSOLPND,"^",12),$P(PSOLPND,"^",13) S ^PS(52.41,"ACL",$P(PSOLPND,"^",13),$P(PSOLPND,"^",12),PSOLPI)=""
106 ...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)=""
107 ...I PSOLPIST="RNW",$P(PSOLPND,"^",21) S ^PS(52.41,"AQ",$P(PSOLPND,"^",21),PSOLPI)=""
108 ...I PSOLPIST="RF" Q
109 ...;Update CPRS with Pending order information on new and renewals
110 ...D EN^PSOHLSN(PSOLPIX,"SC","IP")
111 ..K ^PS(52.41,"APSOD",PSODFN,PSOLPI),ORTYP
112 ..S ENT=ENT+1,ORTYP=$P(^PS(52.41,PSOLPI,0),"^",3)
113 ..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),"^"))
114 ..I $G(MED)']"" S MED="NO DRUG OR ORDERABLE ITEM FOUND"
115 ..S ^TMP("PSOAD",$J,ENT)=$S(ORTYP="RF":"Refill",ORTYP="RNW":"Renew",ORTYP="HD":"On Hold",1:"New")_" Order Request - "
116 ..S ^TMP("PSOAD",$J,ENT)=^TMP("PSOAD",$J,ENT)_"Medication: "_MED
117 I $G(TOTNVA) S ENT=ENT+1,^TMP("PSOAD",$J,ENT)=" " D
118 .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
119 .F NVA=0:0 S NVA=$O(^PS(55,PSODFN,"NVA","APSOD",NVA)) Q:'NVA D
120 ..S PSOOI=$P(^PS(55,PSODFN,"NVA",NVA,0),"^"),PSODD=$P(^(0),"^",2),PLACER=$P(^(0),"^",8),LOCATION=$P(^(0),"^",12),DFN=PSODFN
121 ..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),"^"))
122 ..S $P(^PS(55,PSODFN,"NVA",NVA,0),"^",6)="",$P(^(0),"^",7)="" K ^PS(55,PSODFN,"NVA","APSOD",NVA)
123 ..S ENT=ENT+1,^TMP("PSOAD",$J,ENT)="Non-VA "_MED,REIN=1,PSONVA=NVA D REIN^PSONVNEW
124 ..K PSOOI,PSODD,PLACER,LOCATION,MED,REIN
125 S XMDUZ=.5,XMSUB="Date of Death Deleted for "_$P(^DPT(PSODFN,0),"^")_" ("_VA("BID")_")",XMTEXT="^TMP(""PSOAD"",$J," N DIFROM
126 F I=0:0 S I=$O(^XUSEC("PSORPH",I)) Q:'I S XMY(I)=""
127 D ^XMD
128EX1 K ^TMP("PSOHLD",$J),XMSUB,XMTEXT,XMY,XMDUZ,^TMP("PSOAD",$J),I,TOTRX,TOTPRX,PSODFN,ENT,ORTYP,X,Y,MED,RX,PTDOD
129 Q
Note: See TracBrowser for help on using the repository browser.