source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQWL.m@ 1704

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1ACKQWL ;AUG/JLTP BIR/PTD-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.
4OPTN ;Introduce option.
5 W @IOF,!,"This option compiles the data for the A&SP Capitation Report.",!
6 D GETDT G:$D(DIRUT) EXIT D INIT S ACKMAN=1,ACKDUZ=DUZ
7 S ACKST=$$STATUS() I 'ACKST W !,"Can't continue: ",$P(ACKST,U,3) G EXIT
8BKG ;Queue process to run in the background.
9 S ZTRTN="DQ^ACKQWL",ZTIO="",ZTSAVE("ACK*")=""
10 S ZTDESC="QUASAR - Compile A&SP Capitation Data" D ^%ZTLOAD W:$D(ZTSK) !,"Data generation queued to run in the background." G EXIT
11DQ ;Entry point when queued.
12 N CPT,ICD
13 S:'$D(ACKM) ACKM=$$LM(DT) D:'$D(ACKDA) INIT
14 S ACKST=$$STATUS() I 'ACKST D:'$D(ACKMAN) ABORT^ACKQWB(ACKST) G EXIT
15 I $P(ACKST,U,2)=1 D CREATE G:$D(DIRUT) EXIT
16 D LOG("BEGIN"),^ACKQWL1,LOG("END")
17EXIT ;ALWAYS EXIT HERE
18 K ACKBFY,ACKCP,ACKCPP,ACKCPT,ACKD,ACKDA,ACKDUZ,ACKEM,ACKICP,ACKICD,ACKM,ACKMAN,ACKMO,ACKNU,ACKNV,ACKST,ACKSTOP,ACKV,ACKXFT,ACKXST,ACKZIP
19 K %X,%Y,D0,DA,DFN,DIE,DIRUT,DTOUT,DUOUT,DR,I,VAERR,VAPA,X,XMZ,Y,ZTSK
20 K ^TMP("ACKQWL",$J)
21 S:$D(ZTQUEUED) ZTREQ="@"
22 Q
23GETDT ;Select month for report.
24 N DIR,X,Y
25GDT1 S DIR(0)="D^::APE",DIR("A")="Select Month & Year"
26 S DIR("B")=$$XDAT^ACKQUTL($$LM(DT)),DIR("?")="^D HELP^%DTC"
27 S DIR("??")="^D DATHLP^ACKQWL" D ^DIR Q:$D(DIRUT) S ACKM=$E(Y,1,5)_"00"
28 I ACKM>DT W !,$C(7),"Can't run capitation report for future months!" G GDT1
29 Q
30INIT ;Initialize important variables.
31 N MON
32 S MON=$E(ACKM,1,5),ACKEM=MON_"99",ACKDA=+$$SITE^VASITE()_MON
33 S ACKBFY=$$BFY^ACKQUTL(ACKM)
34 Q
35STATUS() ;Find status of WORKLOAD file (#509850.7).
36 I '$D(^ACK(509850.7,ACKDA,0)) D STA(1) Q X
37 I $P(^ACK(509850.7,ACKDA,0),U,8) D STA(6) Q X
38 I $P(^ACK(509850.7,ACKDA,0),U,6) D STA($S($D(^(4)):4,1:3)) Q X
39 I $P(^ACK(509850.7,ACKDA,0),U,4) D STA(5) Q X
40 I $D(^ACK(509850.7,ACKDA,4,0)) D STA(2) Q X
41 Q 1
42STA(O) S X=$P($T(STA+O),";;",2) D:$P(X,U)="?" STAQES Q
43 ;;1^1^Capitation Report Not Generated - CDR Not Completed
44 ;;1^2^Capitation Report Not Generated - CDR Completed
45 ;;?^3^Capitation Report Already Generated - CDR Not Completed
46 ;;?^4^Capitation Report Already Generated - CDR Completed
47 ;;0^5^Capitation Report Already Running - Not Completed
48 ;;0^6^Capitation Report Already Verified
49STAQES ;If interactive, ask if ok.
50 I $D(ZTQUEUED) S $P(X,U)=1 Q
51 N ACKX,DIR,Y,DIRUT,DUOUT,DTOUT S ACKX=X
52 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Continue",DIR("A",1)=$P(X,U,3)
53 S DIR("?")="Answer Y for YES or N for NO."
54 S DIR("??")="^W !?5,""If you answer YES, I will re-generate capitation data. This will"",!?5,""overwrite existing capitation data for the chosen month."""
55 D ^DIR S X=ACKX,$P(X,U)=$S($D(DIRUT):0,1:+Y) D:X CLEAN
56 Q
57LM(X) ;Find month previous to X.
58 N M,D,Y S M=$E(X,4,5),D=$E(X,6,7),Y=$E(X,1,3),M=M-1
59 S:M<1 M=12,Y=Y-1 S:M<10 M="0"_M
60 Q Y_M_"00"
61CREATE ;Create WORKLOAD file entry.
62 S DIC="^ACK(509850.7,",DIC(0)="L",DLAYGO=509850.7,ACKLAYGO="",X=ACKM,DINUM=ACKDA
63 K DD,DO D FILE^DICN S:Y<0 DIRUT=1
64 Q
65CLEAN ;Clean out previously generated data for month.
66 D WAIT^DICD N X
67 F X=.04,.05,.06 D STF(X,"@",3)
68 F X=1,2,3 D MDEL(X)
69 Q
70STF(F,V,S) ;Use 'S' slash stuff to enter value 'V' in field 'F'.
71 N DIE,DR,DA,SL,X,Y
72 S SL="",$P(SL,"/",S)="/",DIE="^ACK(509850.7,",DA=ACKDA,DR=F_SL_V D ^DIE Q
73MDEL(FLD) ;Delete all entries from multiple field FLD.
74 S DIK="^ACK(509850.7,"_ACKDA_","_FLD_",",DA(1)=ACKDA,SUB=0 D
75 .F S SUB=$O(^ACK(509850.7,ACKDA,FLD,SUB)) Q:'SUB S DA=SUB D ^DIK
76 K DA,DIK,SUB
77 Q
78LOG(X) ;Log the task's start time, end time, and other info.
79 I X="END" D NOW^%DTC D STF(.06,%,4) S ACKXFT=$$HTIM^ACKQUTL(),ACKMO=$$XDAT^ACKQUTL(ACKM) D BUILD^ACKQWB Q
80 S ACKXST=$$HTIM^ACKQUTL D STF(.01,$$XDAT^ACKQUTL(ACKM),3)
81 D NOW^%DTC,STF(.04,%,4),STF(.05,$J,4)
82 Q
83DATHLP ;Extended help - select month for capitation report. (ACKQWL)
84 W !?5,"Select a month, in the past, for which you wish to",!?5,"compile data for the A&SP Capitation Report."
85 Q
Note: See TracBrowser for help on using the repository browser.