source: FOIAVistA/tag/r/QUASAR-ACKQ/ACKQDWLU.m@ 1416

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

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1ACKQDWLU ;AUG/JLTP BIR/PTD HCIOFO/BH-QUASAR Utility Routine ; [ 04/25/96 10:03 ]
2 ;;3.0;QUASAR;**1**;Feb 11, 2000
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;
5WLSTATUS(ACKDA,ACKDIV,ACKWLMSG) ; determine the status for each division
6 ; input : ACKDA=identifier of month to be compiled
7 ;
8 ; array ACKDIV passed by reference (.ACKDIV) containing
9 ; the divisions selected for compilation
10 ; array ACKWLMSG passed by reference (.ACKWLMSG)
11 ; output : ACKWLMSG=status^oktocontinue^message
12 ; and ACKWLMSG(DIV)=null
13 ; where status=0, 1, 2 or 3 (for information only)
14 ; oktocontinue=true, false or unknown (1, 0 or '?')
15 ; message=text message for user
16 ; DIV=list of Divisions the message applies to
17 ; [ ACKWLMSG(DIV) corresponds to ACKDIV(DIV) ]
18 N DIVNUM,DIVIEN,DIVMSG
19 K ACKWLMSG
20 ;
21 ; the following section checks each division to determine the worst
22 ; case. it builds the array ACKWLMSG in the following way
23 ; ACKWLMSG=0^0^message - error, do not proceed.
24 ; ACKWLMSG=1^0^msg,ACKWLMSG(DIV)=null - if one or more
25 ; divisions are currently compiling or have been verified.
26 ; ACKWLMSG=2^?^msg,ACKWLMSG(DIV)=null - if no divisions are
27 ; compiling and none have been verified, but one or more have been
28 ; compiled.
29 ; ACKWLMSG=3^1^msg - no division have been compiled, ok to continue
30 S ACKWLMSG=5,DIVNUM=""
31 F S DIVNUM=$O(ACKDIV(DIVNUM)) Q:DIVNUM="" D
32 . S DIVIEN=$P(ACKDIV(DIVNUM),U,1) ; get division IEN
33 . S DIVMSG=$$WLSTADIV(ACKDA,DIVIEN) ; determine status of this division
34 . ; if this division is no worse than the current status then ignore
35 . I +DIVMSG>ACKWLMSG Q
36 . ; if this division is same as curr status then add to array
37 . I +ACKWLMSG=+DIVMSG S:+ACKWLMSG<3 ACKWLMSG(DIVNUM)="" Q
38 . ; if this division is worse than curr status then refresh array
39 . K ACKWLMSG S ACKWLMSG=DIVMSG S:+ACKWLMSG<3 ACKWLMSG(DIVNUM)=""
40 . ;
41 Q ACKWLMSG
42 ;
43WLSTADIV(ACKDA,DIVIEN) ; determine status of ACKDIV for month ACKDA
44 N MSG
45 I '$D(^ACK(509850.7,ACKDA,5,DIVIEN,0)) D Q MSG
46 . S MSG="3^1^Capitation Report Not Generated"
47 I $P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,8) D Q MSG
48 . S MSG="1^0^Capitation Report Already Verified"
49 I $P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,4) D Q MSG
50 . S MSG="2^?^Capitation Report Already Generated"
51 I $P(^ACK(509850.7,ACKDA,5,DIVIEN,0),U,2) D Q MSG
52 . S MSG="1^0^Capitation Report Already Running - Not Completed"
53 Q "4^1^Capitation report Cleared down"
54 ;
55STAQES(ACKWLMSG) ; Non Interactive run in the background
56 ; input: ACKWLMSG as created in $$WLSTATUS above
57 ; output: 1 if ok to continue, 0 if not
58 ;
59 ; If user not allowed to continue then exit
60 I $P(ACKWLMSG,U,2)=0 Q 0
61 ; Report not generated - set up record and continue
62 I $P(ACKWLMSG,U,1)=3,$P(ACKWLMSG,U,2)=1 Q 2
63 ; Data deleted from file - Okay to go
64 I $P(ACKWLMSG,U,1)=4,$P(ACKWLMSG,U,2)=1 Q 1
65 ; Remaining option is a query - Already been run so quit
66 I $P(ACKWLMSG,U,2)="?" Q 0
67 Q
68 ;
69 ;
70STAQES1(ACKDA,ACKDIV,ACKWLMSG) ; Interactive Version run in the foreground
71 ;
72 ; Input=ACKDA - Site ID and run date selected
73 ; ACKDIV - Cretated in ^ACKQDWL
74 ; ACKWLMSG - Created in WLSTATUS (above)
75 ;
76 N ACKX,DIR,Y,DIRUT,DUOUT,DTOUT,ACKDIVNO
77 ; Display message and associated Divisions
78 ; If status is okay quit passing back 1
79 I $P(ACKWLMSG,U,2)=1 Q 1
80 ; If user is not aloud to continue display problem and quit with "0"
81 I $P(ACKWLMSG,U,2)=0 D DISPLAY Q 0
82 ;
83 ; Remaining option is a query i.e. $P(ACKWLMSG,U,2)="?"
84 ;
85 S ACKDIVNO="" W !
86 W $P(ACKWLMSG,U,3)_" for the following Division(s) ",!!
87 F S ACKDIVNO=$O(ACKWLMSG(ACKDIVNO)) Q:ACKDIVNO="" D
88 . W ?54,$P(ACKDIV(ACKDIVNO),U,3),!
89 ;
90 S DIWL=1,DIWR=80,DIWF=""
91 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Continue",DIR("A",1)=$P(ACKWLMSG,U,3)
92 S DIR("?")="Answer Y for YES or N for NO."
93 S DIR("??")="^W !?5,""If you answer YES, I will re-generate capitation"
94 S DIR("??")=DIR("??")_" data. This will"",!?5,""overwrite existing "
95 S DIR("??")=DIR("??")_"capitation data for the chosen month."""
96 D ^DIR
97 S X=Y
98 ; If user has entered YES clean up files also check that all Division
99 ; levels have been created if no set them up
100 I X D CLEAN
101 Q X
102 ;
103 ;
104DISPLAY ; Display Divisions that have problems
105 ;
106 ; Called from STAQES1
107 ;
108 S ACKDIVNO="" W !!
109 W $P(ACKWLMSG,U,3),!!
110 W "This error has been found for the following Division(s) ",!!
111 F S ACKDIVNO=$O(ACKWLMSG(ACKDIVNO)) Q:ACKDIVNO="" D
112 . W ?44,$P(ACKDIV(ACKDIVNO),U,3),!
113 Q
114 ;
115CLEAN ; Clean out previously generated data for selected divisions
116 ;
117 ; Called from STAQES1
118 ;
119 N X,DIVIEN,ACK1
120 S ACK1=""
121 D WAIT^DICD
122 F S ACK1=$O(ACKDIV(ACK1)) Q:ACK1="" D
123 . S DIVIEN=$P(ACKDIV(ACK1),U,1)
124 . I '$D(^ACK(509850.7,ACKDA,5,DIVIEN)) D CREATE1 Q
125 . D STF
126 . F X=1,2,3,5 D MDL(X,DIVIEN,ACKDA)
127 Q
128 ;
129CREATE(ACKDA,ACKM,ACKDIV) ; Create new date level entry on the workload file
130 ;
131 ; Called from ^ACKQDWL
132 ; Input=ACKDA - Site ID and run date selected
133 ; ACKM - Date run selected in Fm format with '00' for day.
134 ; ACKDIV - Array of Divisions created in ^ACKQDWL
135 ;
136 I '$D(^ACK(509850.7,ACKDA,0)) D
137 . S DIC="^ACK(509850.7,",DIC(0)="L",DLAYGO=509850.7,ACKLAYGO=""
138 . S X=ACKM,DINUM=ACKDA
139 . D FILE^DICN
140 ;
141 ; If they dont exisit create new Division levels in the Workload file
142 N DIVIEN,ACK1,X
143 S ACK1=""
144 F S ACK1=$O(ACKDIV(ACK1)) Q:ACK1="" D
145 . S DIVIEN=$P(ACKDIV(ACK1),U,1)
146 . I $D(^ACK(509850.7,ACKDA,5,DIVIEN)) Q
147 . D CREATE1
148 Q
149 ;
150CREATE1 ; Called from CLEAN code block
151 S DIC="^ACK(509850.7,"_ACKDA_",5,"
152 S DIC(0)="L",DIC("P")="509850.75P"
153 S DA=DIVIEN,DA(1)=ACKDA,X=DIVIEN,DINUM=DIVIEN
154 K DD,DO D FILE^DICN
155 Q
156 ;
157STF ; Delete the Start and end time and Job number from record.
158 ; Called from CLEAN code block.
159 N ACKX,DIE,DR,DA,SL,X,ACKARR
160 S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.02)="@"
161 S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.03)="@"
162 S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.04)="@"
163 D FILE^DIE("K","ACKARR")
164 Q
165 ;
166MDL(FLD,DIVIEN,ACKDA) ; Delete all entries from Multiple
167 ; Called from CLEAN code block.
168 ; Input=FLD - Multiple field level being deleted (1,2 or 3)
169 ; DIVIEN - Division IEN #
170 ; ACKDA - Site ID and run date selected
171 ;
172 N ACKARR,ACKSUB
173 S ACKSUB="0"
174 F S ACKSUB=$O(^ACK(509850.7,ACKDA,5,DIVIEN,FLD,ACKSUB)) Q:'ACKSUB!(ACKSUB'?.N) D
175 . I FLD=1 S ACKARR(509850.751,ACKSUB_","_DIVIEN_","_ACKDA_",",.01)="@"
176 . I FLD=2 S ACKARR(509850.752,ACKSUB_","_DIVIEN_","_ACKDA_",",.01)="@"
177 . I FLD=3 S ACKARR(509850.753,ACKSUB_","_DIVIEN_","_ACKDA_",",.01)="@"
178 . I FLD=5 S ACKARR(509850.755,ACKSUB_","_DIVIEN_","_ACKDA_",",.01)="@"
179 I $D(ACKARR) D FILE^DIE("K","ACKARR")
180 Q
181 ;
182ECSTAT ; For EC Stats.
183 ;
184 N ACKCODE
185 S ACK6=0
186 F S ACK6=$O(^ACK(509850.7,ACKDA,5,ACKVDVN,5,ACK6)) Q:ACK6=""!(ACK6'?.N) D
187 . S ACKREC=^ACK(509850.7,ACKDA,5,ACKVDVN,5,ACK6,0)
188 . S ACKAUD=$P(ACKREC,U,2,4),ACKSPE=$P(ACKREC,U,5,7)
189 . S ACKCODE=$P(ACKREC,U,1)
190 . I $TR(ACKAUD,"^","")'="" D
191 . . S ^TMP("ACKQDWLP",$J,"R",ACKVDVN,5,"A",ACKCODE)=ACKAUD
192 . . S ^TMP("ACKQDWLP",$J,"S",5,"A",ACKCODE,ACKVDVN)=ACKAUD
193 . I $TR(ACKSPE,"^","")'="" D
194 . . S ^TMP("ACKQDWLP",$J,"R",ACKVDVN,5,"S",ACKCODE)=ACKSPE
195 . . S ^TMP("ACKQDWLP",$J,"S",5,"S",ACKCODE,ACKVDVN)=ACKSPE
196 Q
Note: See TracBrowser for help on using the repository browser.