source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCIDC1.m@ 1552

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

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1PSOCIDC1 ;BIR/LE-Copay Correction of erroneous billed copays ;11/8/05 12:50pm
2 ;;7.0;OUTPATIENT PHARMACY;**226**;DEC 1997
3 ;External reference to ^XUSEC supported by DBIA 10076
4 ;External reference to IBARX supported by DBIA 125
5 ;External reference to $$PROD^XUPROD(1) supported by DBIA 4440
6 ;
7 N NAMSP,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,RUNOPT,JOBN,Y
8 S NAMSP=$$NAMSP
9 S JOBN="CANCEL COPAY"
10 ;
11 L +^XTMP(NAMSP):0 I '$T D Q
12 . D BMES^XPDUTL(JOBN_" job is already running. Halting...")
13 . D MES^XPDUTL("")
14 . D QUIT
15 ;
16 I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,"Correct erroneously billed copays, PSO*7*226",90) ;90 day life
17 S QUIT=0
18 ;
19 ;ques 1, if running from mumps prompt
20 I '$D(XPDQUES("POS1")) D I QUIT D QUIT Q
21 . ;selected cancel run at last install, dont allow to run manually
22 . I $G(^XTMP(NAMSP,0,"LAST"))["CANCEL" D Q
23 . . S QUIT=1
24 . . W !!,*7,"The last install of this patch you selected to NOT Run the Copay Correction process."
25 . . W !,"If you have changed your mind, you must re-install the patch to run",!!
26 . K DIR
27 . S DIR("A",1)="****************** SELECT RUN OPTION ******************"
28 . S DIR("A")="Do you want to run the Copay Correction process? Y or N//"
29 . S DIR(0)="YA^^"
30 . D ^DIR I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S QUIT=1 Q
31 . S RUNOPT=Y
32 . S:'RUNOPT QUIT=1
33 ;
34 ;ques 1, if running from kids install
35 I $D(XPDQUES("POS1")) D I 'RUNOPT D QUIT Q
36 . S RUNOPT=XPDQUES("POS1")
37 . S:'RUNOPT ^XTMP(NAMSP,0,"LAST")="CANCEL RUN^"_$$NOW^XLFDT_"^^^"
38 . D BMES^XPDUTL("***** SELECTED "_$S('RUNOPT:"NOT ",1:"")_"TO RUN THE COPAY CORRECTION PROCESS *****")
39 ;
40 I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D Q
41 . W !!,*7,"This job has been run before to completion on "
42 . W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
43 . D QUIT
44 ;
45 ;ques 2, if running from mumps prompt
46 I '$D(XPDQUES("POS2")) D I 'ZTDTH D QUIT Q
47 . K DIR
48 . S DIR("A")="Enter when to Queue the "_JOBN_" job to run in date@time format "
49 . S DIR("B")="NOW"
50 . S DIR(0)="D^::%DT"
51 . S DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 081505@3:30p"
52 . D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
53 . S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
54 ;
55 ;ques 2, if running from kids install
56 I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
57 ;
58 D BMES^XPDUTL("===================================================")
59 D MES^XPDUTL("Queuing background job to "_JOBN_" erroneous billed copays...")
60 D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
61 D MES^XPDUTL("===================================================")
62 I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
63 ;
64 S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
65 ;
66 I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
67 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
68 E D
69 . S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
70 ;
71 S ZTRTN="EN^PSOCIDC1",ZTIO=""
72 S ZTDESC="Background job to "_JOBN_" for erroneously billed copays via PSO*7*143"
73 S ZTSAVE("JOBN")=""
74 L -^XTMP(NAMSP)
75 D ^%ZTLOAD
76 D:$D(ZTSK)
77 . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
78 . D BMES^XPDUTL("")
79 D BMES^XPDUTL("")
80 K XPDQUES
81 Q
82QUIT ;
83 L -^XTMP(NAMSP)
84 Q
85EN ;
86 N NAMSP S NAMSP=$$NAMSP
87 ;if can't get Lock, then already running.
88 L +^XTMP(NAMSP):3 I '$T D Q
89 . S:$D(ZTQUEUED) ZTREQ="@"
90 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
91 ;
92 N DFN,PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOUCNT,PSOCCNT,PSOSTART,PSOEND,PSOVETS,PSOCVETS,PSOUVETS,PSOTRX,XIEN
93 N PSOSCMX,PSODFN,PSOUDFN,PSOREL,PSOAMT,PSOCAMT,PSOUAMT,FOUND,PSOTRF,PSOEND2,PSOSTRT2,CC
94 N PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,PSOUCNTS,PSOCCNTS,LIN,%,X1,XMY,STO,PSOSCP
95 D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
96 S PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
97 I '$G(DT) S DT=$$DT^XLFDT
98 S PSODT=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",3)
99 S RXP=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",4)
100 ;
101 ;get 1st occurence of install date of patch PSO*7*143 (CIDC)
102 S XIEN=+$O(^XPD(9.7,"B","PSO*7.0*156",0))
103 S:'PSODT PSODT=+$P($G(^XPD(9.7,XIEN,1)),"^",3)
104 I 'PSODT D Q
105 . S ^XTMP(NAMSP,0,.1)="CIDC PATCH PSO*7*143 IS NOT INSTALLED"
106 . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
107 . D MAIL3^PSOCIDC3(^XTMP(NAMSP,0,.1))
108 ;
109 S (PSOTRX,PSOTRF)=1
110 N STOP K ^XTMP(NAMSP,0,"STOP") S STOP=0 ;init stop flag to 0
111 F CC=1:1 S PSODT=$O(^PSRX("AD",PSODT)) Q:'PSODT D Q:STOP ;FINISH DATE
112 . I $D(^XTMP(NAMSP,0,"STOP")) D Q
113 . . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
114 . F PSOTRX=PSOTRX+1:1 S RXP=$O(^PSRX("AD",PSODT,RXP)) Q:'RXP D
115 .. Q:'$D(^PSRX(RXP,"ICD",0))
116 .. ;save last date & fill info
117 .. S $P(^XTMP(NAMSP,0,"LAST"),"^",3,5)=PSODT_"^"_RXP_"^"_PSOTRX
118 .. S (DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2)
119 .. Q:('PSODFN)!('$D(^DPT(PSODFN,0))) ;quit, no valid DFN info
120 .. D ELIG^VADPT S PSOSCP="",PSOSCP=$P(VAEL(3),U,2) K VAEL ;SC percentage
121 .. ;search all fills
122 .. S YY="" F S YY=$O(^PSRX("AD",PSODT,RXP,YY)) Q:YY="" D:PSOSCP<50 CHECK^PSOCIDC2
123 G STP:STOP
124 ;
125 S (PSOUCNT,PSOCNT,PSOCCNT)=0
126 D CANCEL^PSOCIDC2 G STP:STOP
127 D TOTAL^PSOCIDC2
128 S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
129 D MAIL^PSOCIDC4
130 D MAIL2^PSOCIDC4
131STP ;
132 L -^XTMP(NAMSP)
133 I $D(^XTMP(NAMSP,0,"STOP")) S ^XTMP(NAMSP,0,"ZAUDIT",$H)="STOPPED ON"_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
134 S:$D(ZTQUEUED) ZTREQ="@"
135 K JOBN
136 Q
137 ;
138STATUS ;show status of job running
139 I $$ST D
140 . W !,"Currently processing:"
141 . I ^XTMP($$NAMSP,0,"LAST")["COMPLETED" D
142 . . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
143 . W !?5,"Released Date > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",3)
144 . W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
145 . W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
146 . E D
147 . I ^XTMP($$NAMSP,0,"LAST")["COMPLETED" D
148 . . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
149 Q
150 ;
151STOP ;stop job command
152 I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
153 . W !,"Outpatient RX Copay Correction Job - set to STOP Soon"
154 . W !!,"Check Status to be sure it has stopped and is not running..."
155 . W !," (D STATUS^PSOCIDC1)"
156 Q
157ST() ;status
158 L +^XTMP($$NAMSP):3 I $T D Q 0
159 . L -^XTMP($$NAMSP)
160 . W !,"*** NOT CURRENTLY RUNNING! ***",!
161 Q 1
162INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
163 N BEGDT,PURGDT
164 S BEGDT=$$NOW^XLFDT()
165 S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
166 S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
167 Q
168NAMSP() ;
169 Q $T(+0)
Note: See TracBrowser for help on using the repository browser.