ACKQDWL ;AUG/JLTP BIR/PTD HCIOFO/BH-Compile A&SP Capitation Data ; [ 05/21/96 11:15 ]
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
OPTN ; Introduce option.
W @IOF,!,"This option compiles the data for the A&SP Capitation Report.",!
DIV ; select Division (user may select one/many/ALL)
S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"IA") G:'ACKDIV EXIT
; get month to be compiled
D GETDT G:$D(DIRUT) EXIT
; initialise other variables
D INIT S ACKMAN=1,ACKDUZ=DUZ
;
; Check the status of the workload file
S ACKWLMSG=$$WLSTATUS^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
; If status does not allow us to run, then exit
S ACKSTAT=$$STAQES1^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
;
I 'ACKSTAT!(ACKSTAT="^") D EXIT G DIV
;
BKG ; Queue process to run in the background.
W !!,"QUASAR - Compile A&SP Capitation Data ",!
;
S ZTRTN="DQ^ACKQDWL",ZTIO="",ZTSAVE("ACK*")=""
S ZTDESC="QUASAR - Compile A&SP Capitation Data" D ^%ZTLOAD
W:$D(ZTSK) !,"Data generation queued to run in the background."
G EXIT
;
DQ ; Entry point when queued.
N CPT,ICD
S:'$D(ACKM) ACKM=$$LM(DT) D:'$D(ACKDA) INIT
S ACKWLMSG=$$WLSTATUS^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
S ACKSTAT=$$STAQES^ACKQDWLU(ACKWLMSG) I 'ACKSTAT D:'$D(ACKMAN) ABORT^ACKQDWB(ACKWLMSG) G EXIT
I ACKSTAT=2 D CREATE^ACKQDWLU(ACKDA,ACKM,.ACKDIV) G:$D(DIRUT) EXIT
D BEGIN
D ^ACKQDWL1
D END
;
;
EXIT ; ALWAYS EXIT HERE
K ACKBFY,ACKCP,ACKCPP,ACKCPT,ACKD,ACKDA,ACKDUZ,ACKEM,ACKICP,ACKICD,ACKM,ACKMAN,ACKMO,ACKNU,ACKNV,ACKST,ACKSTOP,ACKV,ACKXFT,ACKXST,ACKZIP
K %X,%Y,D0,DA,DFN,DIE,DIRUT,DTOUT,DUOUT,DR,I,VAERR,VAPA,X,XMZ,Y,ZTSK
K ^TMP("ACKQWL",$J),ACKXSDTE,ACKXEDTE,ACKDIV
K ACKSTAT,ACKST,ACKK1,ACKN,ACKDEF,ACKVDVN,ACKX,DIVIEN,DIVARR
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
GETDT ; Select month for report.
N DIR,X,Y
GDT1 S DIR(0)="D^::APE",DIR("A")="Select Month & Year"
S DIR("B")=$$XDAT^ACKQUTL($$LM(DT)),DIR("?")="^D HELP^%DTC"
S DIR("??")="^D DATHLP^ACKQDWL"
D ^DIR Q:$D(DIRUT)
S ACKM=$E(Y,1,5)_"00"
I ACKM>DT W !,$C(7),"Can't run capitation report for future months!" G GDT1
Q
;
INIT ; Initialize important variables.
N MON
S MON=$E(ACKM,1,5),ACKEM=MON_"99",ACKDA=+$$SITE^VASITE()_MON
S ACKBFY=$$BFY^ACKQUTL(ACKM)
Q
;
LM(X) ; Find month previous to X.
N M,D,Y S M=$E(X,4,5),D=$E(X,6,7),Y=$E(X,1,3),M=M-1
S:M<1 M=12,Y=Y-1 S:M<10 M="0"_M
Q Y_M_"00"
;
DATHLP ; Extended help - select month for capitation report. (ACKQWL)
W !?5,"Enter a date, in the past, for which you wish to",!?5,"compile data for the A&SP Capitation Report."
Q
;
END ; Set END date field into header for Division and Date
N ACKARR
D NOW^%DTC
S DIVNUM=""
F S DIVNUM=$O(ACKDIV(DIVNUM)) Q:DIVNUM="" D
. S DIVIEN=$P(ACKDIV(DIVNUM),U,1)
. S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.04)=%
D FILE^DIE("K","ACKARR")
D NOW^%DTC
S Y=X D DD^%DT S ACKXEDTE=Y
S ACKXFT=$$HTIM^ACKQUTL(),ACKMO=$$XDAT^ACKQUTL(ACKM) D BUILD^ACKQDWB
K ACKDIV
Q
;
BEGIN ; Set START date and Job # into header record for Division and date
N ACKARR
D NOW^%DTC
S Y=X D DD^%DT S ACKXSDTE=Y
S ACKXST=$$HTIM^ACKQUTL
S DIVNUM=""
F S DIVNUM=$O(ACKDIV(DIVNUM)) Q:DIVNUM="" D
. S DIVIEN=$P(ACKDIV(DIVNUM),U,1)
. S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.02)=%
. S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.03)=$J
D FILE^DIE("K","ACKARR")
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQDWL 3439 printed Dec 13, 2024@02:32:06 Page 2
ACKQDWL ;AUG/JLTP BIR/PTD HCIOFO/BH-Compile A&SP Capitation Data ; [ 05/21/96 11:15 ]
+1 ;;3.0;QUASAR;;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
OPTN ; Introduce option.
+1 WRITE @IOF,!,"This option compiles the data for the A&SP Capitation Report.",!
DIV ; select Division (user may select one/many/ALL)
+1 SET ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"IA")
if 'ACKDIV
GOTO EXIT
+2 ; get month to be compiled
+3 DO GETDT
if $DATA(DIRUT)
GOTO EXIT
+4 ; initialise other variables
+5 DO INIT
SET ACKMAN=1
SET ACKDUZ=DUZ
+6 ;
+7 ; Check the status of the workload file
+8 SET ACKWLMSG=$$WLSTATUS^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
+9 ; If status does not allow us to run, then exit
+10 SET ACKSTAT=$$STAQES1^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
+11 ;
+12 IF 'ACKSTAT!(ACKSTAT="^")
DO EXIT
GOTO DIV
+13 ;
BKG ; Queue process to run in the background.
+1 WRITE !!,"QUASAR - Compile A&SP Capitation Data ",!
+2 ;
+3 SET ZTRTN="DQ^ACKQDWL"
SET ZTIO=""
SET ZTSAVE("ACK*")=""
+4 SET ZTDESC="QUASAR - Compile A&SP Capitation Data"
DO ^%ZTLOAD
+5 if $DATA(ZTSK)
WRITE !,"Data generation queued to run in the background."
+6 GOTO EXIT
+7 ;
DQ ; Entry point when queued.
+1 NEW CPT,ICD
+2 if '$DATA(ACKM)
SET ACKM=$$LM(DT)
if '$DATA(ACKDA)
DO INIT
+3 SET ACKWLMSG=$$WLSTATUS^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
+4 SET ACKSTAT=$$STAQES^ACKQDWLU(ACKWLMSG)
IF 'ACKSTAT
if '$DATA(ACKMAN)
DO ABORT^ACKQDWB(ACKWLMSG)
GOTO EXIT
+5 IF ACKSTAT=2
DO CREATE^ACKQDWLU(ACKDA,ACKM,.ACKDIV)
if $DATA(DIRUT)
GOTO EXIT
+6 DO BEGIN
+7 DO ^ACKQDWL1
+8 DO END
+9 ;
+10 ;
EXIT ; ALWAYS EXIT HERE
+1 KILL ACKBFY,ACKCP,ACKCPP,ACKCPT,ACKD,ACKDA,ACKDUZ,ACKEM,ACKICP,ACKICD,ACKM,ACKMAN,ACKMO,ACKNU,ACKNV,ACKST,ACKSTOP,ACKV,ACKXFT,ACKXST,ACKZIP
+2 KILL %X,%Y,D0,DA,DFN,DIE,DIRUT,DTOUT,DUOUT,DR,I,VAERR,VAPA,X,XMZ,Y,ZTSK
+3 KILL ^TMP("ACKQWL",$JOB),ACKXSDTE,ACKXEDTE,ACKDIV
+4 KILL ACKSTAT,ACKST,ACKK1,ACKN,ACKDEF,ACKVDVN,ACKX,DIVIEN,DIVARR
+5 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
+7 ;
GETDT ; Select month for report.
+1 NEW DIR,X,Y
GDT1 SET DIR(0)="D^::APE"
SET DIR("A")="Select Month & Year"
+1 SET DIR("B")=$$XDAT^ACKQUTL($$LM(DT))
SET DIR("?")="^D HELP^%DTC"
+2 SET DIR("??")="^D DATHLP^ACKQDWL"
+3 DO ^DIR
if $DATA(DIRUT)
QUIT
+4 SET ACKM=$EXTRACT(Y,1,5)_"00"
+5 IF ACKM>DT
WRITE !,$CHAR(7),"Can't run capitation report for future months!"
GOTO GDT1
+6 QUIT
+7 ;
INIT ; Initialize important variables.
+1 NEW MON
+2 SET MON=$EXTRACT(ACKM,1,5)
SET ACKEM=MON_"99"
SET ACKDA=+$$SITE^VASITE()_MON
+3 SET ACKBFY=$$BFY^ACKQUTL(ACKM)
+4 QUIT
+5 ;
LM(X) ; Find month previous to X.
+1 NEW M,D,Y
SET M=$EXTRACT(X,4,5)
SET D=$EXTRACT(X,6,7)
SET Y=$EXTRACT(X,1,3)
SET M=M-1
+2 if M<1
SET M=12
SET Y=Y-1
if M<10
SET M="0"_M
+3 QUIT Y_M_"00"
+4 ;
DATHLP ; Extended help - select month for capitation report. (ACKQWL)
+1 WRITE !?5,"Enter a date, in the past, for which you wish to",!?5,"compile data for the A&SP Capitation Report."
+2 QUIT
+3 ;
END ; Set END date field into header for Division and Date
+1 NEW ACKARR
+2 DO NOW^%DTC
+3 SET DIVNUM=""
+4 FOR
SET DIVNUM=$ORDER(ACKDIV(DIVNUM))
if DIVNUM=""
QUIT
Begin DoDot:1
+5 SET DIVIEN=$PIECE(ACKDIV(DIVNUM),U,1)
+6 SET ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.04)=%
End DoDot:1
+7 DO FILE^DIE("K","ACKARR")
+8 DO NOW^%DTC
+9 SET Y=X
DO DD^%DT
SET ACKXEDTE=Y
+10 SET ACKXFT=$$HTIM^ACKQUTL()
SET ACKMO=$$XDAT^ACKQUTL(ACKM)
DO BUILD^ACKQDWB
+11 KILL ACKDIV
+12 QUIT
+13 ;
BEGIN ; Set START date and Job # into header record for Division and date
+1 NEW ACKARR
+2 DO NOW^%DTC
+3 SET Y=X
DO DD^%DT
SET ACKXSDTE=Y
+4 SET ACKXST=$$HTIM^ACKQUTL
+5 SET DIVNUM=""
+6 FOR
SET DIVNUM=$ORDER(ACKDIV(DIVNUM))
if DIVNUM=""
QUIT
Begin DoDot:1
+7 SET DIVIEN=$PIECE(ACKDIV(DIVNUM),U,1)
+8 SET ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.02)=%
+9 SET ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.03)=$JOB
End DoDot:1
+10 DO FILE^DIE("K","ACKARR")
+11 QUIT
+12 ;
+13 ;
