source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCIDC9.m@ 1520

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

initial load of WorldVistAEHR

File size: 6.9 KB
Line 
1PSOCIDC9 ;BIR/LE - continuation of activity log corrections ;2/28/05 12:50pm
2 ;;7.0;OUTPATIENT PHARMACY;**239,250**;DEC 1997
3 ;
4RPT ;
5 N JOBN,NAMSP,ZTDESC,ZTRTN,ZTQUEUED,ZTREQ
6 S NAMSP=$$NAMSP^PSOCIDC7
7 S JOBN="CIDC ACTIVITY LOG CORRECTION"
8 L +^XTMP(NAMSP):0 I '$T D Q
9 .W !,JOBN_" job for PSO*7*239 is still running. Halting..."
10 L -^XTMP(NAMSP)
11 W !!,"This report reflects all prescriptions where the activity and"
12 W !,"copay activity logs were corrected. For detailed information,"
13 W !,"please view the activity and copay logs on the prescriptions."
14 ;
15 W !!,"You may queue the report to print, if you wish.",!
16 ;
17DVC ;
18 K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
19QUEUE ;
20 I $D(IO("Q")) S ZTRTN="START^PSOCIDC9",ZTDESC=JOBN_" CIDC Activity Logs Corrections" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
21START ;
22 U IO
23 N BLDT,RXO,NAMSP,PSOFILL,PSODFN,PSONAM,PSOOUT,PSODV,RXP,SSN,PSODIV,PSODV
24 N CANCEL,JOBN,PSOPATID,PSOTOT
25 S NAMSP=$$NAMSP^PSOCIDC7
26 ;****************************************************** for testing only - next line
27 S JOBN="CIDC ACTIVITY LOGS CORRECTION"
28 S PSOOUT=0,PSODV=$S($E(IOST)="C":"C",1:"P")
29 S PSOPGCT=0,PSOPGLN=IOSL-7,PSOPGCT=1
30 S BLDT=$P($G(^XTMP(NAMSP,0,"LAST")),"^",2)
31 I '$D(DT) S DT=$$NOW^XLFDT
32 D TITLE
33 S (PSOTOT,PSONAM)=""
34 F S PSONAM=$O(^XTMP(NAMSP,"LOG",PSONAM)) Q:PSONAM="" D
35 .S PSODFN=""
36 .F S PSODFN=$O(^XTMP(NAMSP,"LOG",PSONAM,PSODFN)) Q:PSODFN="" D
37 ..S RXP=""
38 ..F S RXP=$O(^XTMP(NAMSP,"LOG",PSONAM,PSODFN,RXP)) Q:RXP="" D
39 ...D FULL Q:$G(PSOOUT) S PSONAME=$P($G(^DPT(PSODFN,0)),"^"),PSOTOT=PSOTOT+1
40 ...W !,$E(PSONAME,1,14)
41 ...D PRTSSN
42 ...S RXO=$P($G(^PSRX(RXP,0)),"^")
43 ...W ?41," ",RXO ;," (",PSOFILL,")"
44 W:PSOTOT'="" !,"Total number of prescriptions modified: ",PSOTOT
45 G END
46 ;
47FULL ;
48 I ($Y+7)>IOSL&('$G(PSOOUT)) D TITLE
49 Q
50 ;
51TITLE ;
52 I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
53 ;
54 W @IOF D
55 . W !,"Patch PSO*7*239 - Corrected Activity and Copay Activity logs",!!
56 . W "Note that this report reflects all prescriptions where the activity and/or",!
57 . W "copay activity logs were corrected. For detailed information, please view",!
58 . W "the activity and copay activity log on the prescription.",!
59 ;
60 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
61 F MJT=1:1:79 W "="
62 ;W !?55,"Updated",?67,"Updated"
63 ;W !,?55,"Activity",?67,"COPAY"
64 W !,"PATIENT NAME (SSN) DIV",?42,"RX# " ;,?55,"Log",?67,"Activity Log" ;,?55,"RELEASE DATE",?69,"REL BILL"
65 W !,"--------------- ------- --------------",?42,"------------"
66 ;W ?55,"------------",?67,"-----------"
67 S PSOPGCT=PSOPGCT+1
68 Q
69 ;
70END ;
71 I '$G(PSOOUT),$G(PSODV)="C" W !!,"** End of Report **" K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
72 I $G(PSODV)="C" W !
73 E W @IOF
74DONE ;
75 K MJT,PSOPGCT,PSOPGLN,Y,DIR,X,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT
76 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
77 Q
78 ;
79PRTSSN ;
80 S SSN=$P(^DPT(PSODFN,0),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN))
81 S PSOPATID=$E(PSONAM,1)_SSN
82 S PSODIV=$P($G(^PSRX(RXP,2)),"^",9)
83 S:PSODIV'="" PSODIV=$P($G(^PS(59,PSODIV,0)),"^",1)
84 W ?17,"("_PSOPATID_")"_" "_$E(PSODIV,1,15)
85 Q
86 ;------
87LOCKED ;LIST OF LOCKED RX'S
88 N JOBN,NAMSP,ZTDESC,ZTRTN,ZTQUEUED,ZTREQ,PSODV
89 S NAMSP=$$NAMSP^PSOCIDC7
90 S JOBN="CIDC ACTIVITY LOG CORRECTION - LOCKED PRESCRIPTIONS"
91 L +^XTMP(NAMSP):0 I '$T D Q
92 .W !,JOBN_" job for PSO*7*239 is still running. Halting..."
93 L -^XTMP(NAMSP)
94 W !!,"This report reflects all prescriptions where the activity and",!
95 W "copay activity logs could not be corrected due to the Rx being locked."
96 ;
97 W !!,"You may queue the report to print, if you wish.",!
98 ;
99DVC2 ;
100 K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
101QUEUE2 ;
102 I $D(IO("Q")) S ZTRTN="START2^PSOCIDC9",ZTDESC=JOBN_" CIDC Activity Logs Corrections - Locked Rx's" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
103START2 ;
104 U IO
105 N BLDT,NAMSP,PSODFN,PSONAM,PSONAME,PSOOUT,PSODV,RXP,SSN,PSODIV,PSOPGCT,PSOOUT
106 N CANCEL,JOBN,PSOPATID,PSOTOT,PSONCNT,PSORXN
107 S NAMSP=$$NAMSP^PSOCIDC7
108 S JOBN="CIDC ACTIVITY LOGS CORRECTION - Locked Rx report"
109 S (PSOPGCT,PSONCNT,PSOOUT)=0,PSODV=$S($E(IOST)="C":"C",1:"P")
110 S PSOPGLN=IOSL-7,PSOPGCT=1,RXP=""
111 S BLDT=$P($G(^XTMP(NAMSP,0,"LAST")),"^",2)
112 I '$D(DT) S DT=$$NOW^XLFDT
113 D TITLE2
114 F S RXP=$O(^XTMP(NAMSP,0,"LOCKED RX",RXP)) Q:RXP="" D
115 . D FULL2 Q:$G(PSOOUT)
116 . S PSONCNT=PSONCNT+1
117 . S (DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2),PSORXN=$P($G(^PSRX(RXP,0)),"^")
118 . S (PSONAME,PSONAM)=$P($G(^DPT(PSODFN,0)),"^") W !,$E(PSONAME,1,14)
119 . D PRTSSN
120 . W ?41," ",PSORXN
121 . W:^XTMP(NAMSP,0,"LOCKED RX",RXP)'="" ?60,"CORRECTED"
122 W !!,"Total number of prescriptions locked: ",PSONCNT,!
123 G END
124 Q
125 ;
126FULL2 ;
127 I ($Y+7)>IOSL&('$G(PSOOUT)) D TITLE2
128 Q
129 ;
130TITLE2 ;
131 I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
132 ;
133 W @IOF D
134 . W !,"Patch PSO*7*239 - Locked Prescription Number Report",!!
135 . W "Note that this report reflects all prescriptions where the activity and/or",!
136 . W "copay activity logs could not be corrected. For detailed information,",!
137 . W "please view the activity and copay activity log on the prescription.",!
138 . W !!,"Note that FIXONE^PSOCIDC9 can be run from programmer's mode"
139 . W !,"to correct individual prescriptions.",!!
140 ;
141 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
142 F MJT=1:1:79 W "="
143 ;
144 W !,"PATIENT NAME (SSN) DIV",?42,"RX# "
145 W !,"--------------- ------- --------------",?42,"------------"
146 S PSOPGCT=PSOPGCT+1
147 Q
148 ;
149FIXONE ;FIX LOCKED RX'S
150 N RXP,SEQ,CSEQ,PSOMSG,PSONTIM,PSOCHECK,FIXONE,PSOFONE,NAMSP
151 W @IOF D
152 . W !,"This function is used to correct individual prescriptions that were locked"
153 . W !,"during the CIDC Activity Log clean-up process. It verifies whether the"
154 . W !,"prescription needs to be corrected, and if so corrects it. If the Rx still"
155 . W !,"cannot be locked for correction, a message stating such will be displayed."
156 . W !,"Otherwise, a message stating that no correction is needed will be displayed.",!
157 . W !,"For detailed information please view the activity and copay activity log on"
158 . W !,"the prescription. For a listing of locked Rx's, type D LOCKED^PSOCIDC9 at"
159 . W !,"the programmer's prompt.",!
160 ;
161FIX2 ;
162 S (PSOMSG,PSONTIM,FIXONE,PSOFONE)=""
163 K DIC
164 W ! S DIC="^PSRX(",DIC(0)="QEA" D ^DIC Q:Y<0
165 S RXP=+Y,(DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2),PSONAM=$P($G(^DPT(PSODFN,0)),"^")
166 W !,"For Patient: ",PSONAM
167 S (PSOCHECK,SEQ,CSEQ)=0,NAMSP=$$NAMSP^PSOCIDC7
168 I $D(^PSRX(RXP,"A",0)) F S SEQ=$O(^PSRX(RXP,"A",SEQ)) Q:SEQ="" I $G(^PSRX(RXP,"A",SEQ,0))["BKGD CIDC" S PSOCHECK=1
169 I $D(^PSRX(RXP,"COPAY",0)) F S CSEQ=$O(^PSRX(RXP,"COPAY",CSEQ)) Q:CSEQ="" I $G(^PSRX(RXP,"COPAY",CSEQ,0))["BKGD CIDC" S PSOCHECK=1
170 I 'PSOCHECK W !!,"No changes are needed for this prescription.",! G FIX2
171 S FIXONE=1 D CHECK^PSOCIDC8
172 I '$G(PSOFONE) W !,"Activity logs corrected.",!! S ^XTMP("PSOCIDC7",0,"LOCKED RX",RXP)=DUZ_"^"_$H
173 G FIX2
174 Q
Note: See TracBrowser for help on using the repository browser.