source: FOIAVistA/trunk/r/QUASAR-ACKQ/ACKQDWL.m@ 1458

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1ACKQDWL ;AUG/JLTP BIR/PTD HCIOFO/BH-Compile A&SP Capitation Data ; [ 05/21/96 11:15 ]
2 ;;3.0;QUASAR;;Feb 11, 2000
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 ;
5OPTN ; Introduce option.
6 W @IOF,!,"This option compiles the data for the A&SP Capitation Report.",!
7DIV ; select Division (user may select one/many/ALL)
8 S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"IA") G:'ACKDIV EXIT
9 ; get month to be compiled
10 D GETDT G:$D(DIRUT) EXIT
11 ; initialise other variables
12 D INIT S ACKMAN=1,ACKDUZ=DUZ
13 ;
14 ; Check the status of the workload file
15 S ACKWLMSG=$$WLSTATUS^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
16 ; If status does not allow us to run, then exit
17 S ACKSTAT=$$STAQES1^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
18 ;
19 I 'ACKSTAT!(ACKSTAT="^") D EXIT G DIV
20 ;
21BKG ; Queue process to run in the background.
22 W !!,"QUASAR - Compile A&SP Capitation Data ",!
23 ;
24 S ZTRTN="DQ^ACKQDWL",ZTIO="",ZTSAVE("ACK*")=""
25 S ZTDESC="QUASAR - Compile A&SP Capitation Data" D ^%ZTLOAD
26 W:$D(ZTSK) !,"Data generation queued to run in the background."
27 G EXIT
28 ;
29DQ ; Entry point when queued.
30 N CPT,ICD
31 S:'$D(ACKM) ACKM=$$LM(DT) D:'$D(ACKDA) INIT
32 S ACKWLMSG=$$WLSTATUS^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
33 S ACKSTAT=$$STAQES^ACKQDWLU(ACKWLMSG) I 'ACKSTAT D:'$D(ACKMAN) ABORT^ACKQDWB(ACKWLMSG) G EXIT
34 I ACKSTAT=2 D CREATE^ACKQDWLU(ACKDA,ACKM,.ACKDIV) G:$D(DIRUT) EXIT
35 D BEGIN
36 D ^ACKQDWL1
37 D END
38 ;
39 ;
40EXIT ; ALWAYS EXIT HERE
41 K ACKBFY,ACKCP,ACKCPP,ACKCPT,ACKD,ACKDA,ACKDUZ,ACKEM,ACKICP,ACKICD,ACKM,ACKMAN,ACKMO,ACKNU,ACKNV,ACKST,ACKSTOP,ACKV,ACKXFT,ACKXST,ACKZIP
42 K %X,%Y,D0,DA,DFN,DIE,DIRUT,DTOUT,DUOUT,DR,I,VAERR,VAPA,X,XMZ,Y,ZTSK
43 K ^TMP("ACKQWL",$J),ACKXSDTE,ACKXEDTE,ACKDIV
44 K ACKSTAT,ACKST,ACKK1,ACKN,ACKDEF,ACKVDVN,ACKX,DIVIEN,DIVARR
45 S:$D(ZTQUEUED) ZTREQ="@"
46 Q
47 ;
48GETDT ; Select month for report.
49 N DIR,X,Y
50GDT1 S DIR(0)="D^::APE",DIR("A")="Select Month & Year"
51 S DIR("B")=$$XDAT^ACKQUTL($$LM(DT)),DIR("?")="^D HELP^%DTC"
52 S DIR("??")="^D DATHLP^ACKQDWL"
53 D ^DIR Q:$D(DIRUT)
54 S ACKM=$E(Y,1,5)_"00"
55 I ACKM>DT W !,$C(7),"Can't run capitation report for future months!" G GDT1
56 Q
57 ;
58INIT ; Initialize important variables.
59 N MON
60 S MON=$E(ACKM,1,5),ACKEM=MON_"99",ACKDA=+$$SITE^VASITE()_MON
61 S ACKBFY=$$BFY^ACKQUTL(ACKM)
62 Q
63 ;
64LM(X) ; Find month previous to X.
65 N M,D,Y S M=$E(X,4,5),D=$E(X,6,7),Y=$E(X,1,3),M=M-1
66 S:M<1 M=12,Y=Y-1 S:M<10 M="0"_M
67 Q Y_M_"00"
68 ;
69DATHLP ; Extended help - select month for capitation report. (ACKQWL)
70 W !?5,"Enter a date, in the past, for which you wish to",!?5,"compile data for the A&SP Capitation Report."
71 Q
72 ;
73END ; Set END date field into header for Division and Date
74 N ACKARR
75 D NOW^%DTC
76 S DIVNUM=""
77 F S DIVNUM=$O(ACKDIV(DIVNUM)) Q:DIVNUM="" D
78 . S DIVIEN=$P(ACKDIV(DIVNUM),U,1)
79 . S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.04)=%
80 D FILE^DIE("K","ACKARR")
81 D NOW^%DTC
82 S Y=X D DD^%DT S ACKXEDTE=Y
83 S ACKXFT=$$HTIM^ACKQUTL(),ACKMO=$$XDAT^ACKQUTL(ACKM) D BUILD^ACKQDWB
84 K ACKDIV
85 Q
86 ;
87BEGIN ; Set START date and Job # into header record for Division and date
88 N ACKARR
89 D NOW^%DTC
90 S Y=X D DD^%DT S ACKXSDTE=Y
91 S ACKXST=$$HTIM^ACKQUTL
92 S DIVNUM=""
93 F S DIVNUM=$O(ACKDIV(DIVNUM)) Q:DIVNUM="" D
94 . S DIVIEN=$P(ACKDIV(DIVNUM),U,1)
95 . S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.02)=%
96 . S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.03)=$J
97 D FILE^DIE("K","ACKARR")
98 Q
99 ;
100 ;
Note: See TracBrowser for help on using the repository browser.