- ACKQWL ;AUG/JLTP BIR/PTD-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.",!
- D GETDT G:$D(DIRUT) EXIT D INIT S ACKMAN=1,ACKDUZ=DUZ
- S ACKST=$$STATUS() I 'ACKST W !,"Can't continue: ",$P(ACKST,U,3) G EXIT
- BKG ;Queue process to run in the background.
- S ZTRTN="DQ^ACKQWL",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 ACKST=$$STATUS() I 'ACKST D:'$D(ACKMAN) ABORT^ACKQWB(ACKST) G EXIT
- I $P(ACKST,U,2)=1 D CREATE G:$D(DIRUT) EXIT
- D LOG("BEGIN"),^ACKQWL1,LOG("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)
- 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^ACKQWL" 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
- STATUS() ;Find status of WORKLOAD file (#509850.7).
- I '$D(^ACK(509850.7,ACKDA,0)) D STA(1) Q X
- I $P(^ACK(509850.7,ACKDA,0),U,8) D STA(6) Q X
- I $P(^ACK(509850.7,ACKDA,0),U,6) D STA($S($D(^(4)):4,1:3)) Q X
- I $P(^ACK(509850.7,ACKDA,0),U,4) D STA(5) Q X
- I $D(^ACK(509850.7,ACKDA,4,0)) D STA(2) Q X
- Q 1
- STA(O) S X=$P($T(STA+O),";;",2) D:$P(X,U)="?" STAQES Q
- ;;1^1^Capitation Report Not Generated - CDR Not Completed
- ;;1^2^Capitation Report Not Generated - CDR Completed
- ;;?^3^Capitation Report Already Generated - CDR Not Completed
- ;;?^4^Capitation Report Already Generated - CDR Completed
- ;;0^5^Capitation Report Already Running - Not Completed
- ;;0^6^Capitation Report Already Verified
- STAQES ;If interactive, ask if ok.
- I $D(ZTQUEUED) S $P(X,U)=1 Q
- N ACKX,DIR,Y,DIRUT,DUOUT,DTOUT S ACKX=X
- S DIR(0)="Y",DIR("B")="NO",DIR("A")="Continue",DIR("A",1)=$P(X,U,3)
- S DIR("?")="Answer Y for YES or N for NO."
- 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."""
- D ^DIR S X=ACKX,$P(X,U)=$S($D(DIRUT):0,1:+Y) D:X CLEAN
- 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"
- CREATE ;Create WORKLOAD file entry.
- S DIC="^ACK(509850.7,",DIC(0)="L",DLAYGO=509850.7,ACKLAYGO="",X=ACKM,DINUM=ACKDA
- K DD,DO D FILE^DICN S:Y<0 DIRUT=1
- Q
- CLEAN ;Clean out previously generated data for month.
- D WAIT^DICD N X
- F X=.04,.05,.06 D STF(X,"@",3)
- F X=1,2,3 D MDEL(X)
- Q
- STF(F,V,S) ;Use 'S' slash stuff to enter value 'V' in field 'F'.
- N DIE,DR,DA,SL,X,Y
- S SL="",$P(SL,"/",S)="/",DIE="^ACK(509850.7,",DA=ACKDA,DR=F_SL_V D ^DIE Q
- MDEL(FLD) ;Delete all entries from multiple field FLD.
- S DIK="^ACK(509850.7,"_ACKDA_","_FLD_",",DA(1)=ACKDA,SUB=0 D
- .F S SUB=$O(^ACK(509850.7,ACKDA,FLD,SUB)) Q:'SUB S DA=SUB D ^DIK
- K DA,DIK,SUB
- Q
- LOG(X) ;Log the task's start time, end time, and other info.
- I X="END" D NOW^%DTC D STF(.06,%,4) S ACKXFT=$$HTIM^ACKQUTL(),ACKMO=$$XDAT^ACKQUTL(ACKM) D BUILD^ACKQWB Q
- S ACKXST=$$HTIM^ACKQUTL D STF(.01,$$XDAT^ACKQUTL(ACKM),3)
- D NOW^%DTC,STF(.04,%,4),STF(.05,$J,4)
- Q
- DATHLP ;Extended help - select month for capitation report. (ACKQWL)
- W !?5,"Select a month, in the past, for which you wish to",!?5,"compile data for the A&SP Capitation Report."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQWL 4035 printed Jan 18, 2025@03:34:09 Page 2
- ACKQWL ;AUG/JLTP BIR/PTD-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.
- OPTN ;Introduce option.
- +1 WRITE @IOF,!,"This option compiles the data for the A&SP Capitation Report.",!
- +2 DO GETDT
- if $DATA(DIRUT)
- GOTO EXIT
- DO INIT
- SET ACKMAN=1
- SET ACKDUZ=DUZ
- +3 SET ACKST=$$STATUS()
- IF 'ACKST
- WRITE !,"Can't continue: ",$PIECE(ACKST,U,3)
- GOTO EXIT
- BKG ;Queue process to run in the background.
- +1 SET ZTRTN="DQ^ACKQWL"
- SET ZTIO=""
- SET ZTSAVE("ACK*")=""
- +2 SET ZTDESC="QUASAR - Compile A&SP Capitation Data"
- DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !,"Data generation queued to run in the background."
- GOTO EXIT
- DQ ;Entry point when queued.
- +1 NEW CPT,ICD
- +2 if '$DATA(ACKM)
- SET ACKM=$$LM(DT)
- if '$DATA(ACKDA)
- DO INIT
- +3 SET ACKST=$$STATUS()
- IF 'ACKST
- if '$DATA(ACKMAN)
- DO ABORT^ACKQWB(ACKST)
- GOTO EXIT
- +4 IF $PIECE(ACKST,U,2)=1
- DO CREATE
- if $DATA(DIRUT)
- GOTO EXIT
- +5 DO LOG("BEGIN")
- DO ^ACKQWL1
- DO LOG("END")
- 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)
- +4 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +5 QUIT
- 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^ACKQWL"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- SET ACKM=$EXTRACT(Y,1,5)_"00"
- +3 IF ACKM>DT
- WRITE !,$CHAR(7),"Can't run capitation report for future months!"
- GOTO GDT1
- +4 QUIT
- 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
- STATUS() ;Find status of WORKLOAD file (#509850.7).
- +1 IF '$DATA(^ACK(509850.7,ACKDA,0))
- DO STA(1)
- QUIT X
- +2 IF $PIECE(^ACK(509850.7,ACKDA,0),U,8)
- DO STA(6)
- QUIT X
- +3 IF $PIECE(^ACK(509850.7,ACKDA,0),U,6)
- DO STA($SELECT($DATA(^(4)):4,1:3))
- QUIT X
- +4 IF $PIECE(^ACK(509850.7,ACKDA,0),U,4)
- DO STA(5)
- QUIT X
- +5 IF $DATA(^ACK(509850.7,ACKDA,4,0))
- DO STA(2)
- QUIT X
- +6 QUIT 1
- STA(O) SET X=$PIECE($TEXT(STA+O),";;",2)
- if $PIECE(X,U)="?"
- DO STAQES
- QUIT
- +1 ;;1^1^Capitation Report Not Generated - CDR Not Completed
- +2 ;;1^2^Capitation Report Not Generated - CDR Completed
- +3 ;;?^3^Capitation Report Already Generated - CDR Not Completed
- +4 ;;?^4^Capitation Report Already Generated - CDR Completed
- +5 ;;0^5^Capitation Report Already Running - Not Completed
- +6 ;;0^6^Capitation Report Already Verified
- STAQES ;If interactive, ask if ok.
- +1 IF $DATA(ZTQUEUED)
- SET $PIECE(X,U)=1
- QUIT
- +2 NEW ACKX,DIR,Y,DIRUT,DUOUT,DTOUT
- SET ACKX=X
- +3 SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Continue"
- SET DIR("A",1)=$PIECE(X,U,3)
- +4 SET DIR("?")="Answer Y for YES or N for NO."
- +5 SET DIR("??")="^W !?5,""If you answer YES, I will re-generate capitation data. This will"",!?5,""overwrite existing capitation data for the chosen month."""
- +6 DO ^DIR
- SET X=ACKX
- SET $PIECE(X,U)=$SELECT($DATA(DIRUT):0,1:+Y)
- if X
- DO CLEAN
- +7 QUIT
- 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"
- CREATE ;Create WORKLOAD file entry.
- +1 SET DIC="^ACK(509850.7,"
- SET DIC(0)="L"
- SET DLAYGO=509850.7
- SET ACKLAYGO=""
- SET X=ACKM
- SET DINUM=ACKDA
- +2 KILL DD,DO
- DO FILE^DICN
- if Y<0
- SET DIRUT=1
- +3 QUIT
- CLEAN ;Clean out previously generated data for month.
- +1 DO WAIT^DICD
- NEW X
- +2 FOR X=.04,.05,.06
- DO STF(X,"@",3)
- +3 FOR X=1,2,3
- DO MDEL(X)
- +4 QUIT
- STF(F,V,S) ;Use 'S' slash stuff to enter value 'V' in field 'F'.
- +1 NEW DIE,DR,DA,SL,X,Y
- +2 SET SL=""
- SET $PIECE(SL,"/",S)="/"
- SET DIE="^ACK(509850.7,"
- SET DA=ACKDA
- SET DR=F_SL_V
- DO ^DIE
- QUIT
- MDEL(FLD) ;Delete all entries from multiple field FLD.
- +1 SET DIK="^ACK(509850.7,"_ACKDA_","_FLD_","
- SET DA(1)=ACKDA
- SET SUB=0
- Begin DoDot:1
- +2 FOR
- SET SUB=$ORDER(^ACK(509850.7,ACKDA,FLD,SUB))
- if 'SUB
- QUIT
- SET DA=SUB
- DO ^DIK
- End DoDot:1
- +3 KILL DA,DIK,SUB
- +4 QUIT
- LOG(X) ;Log the task's start time, end time, and other info.
- +1 IF X="END"
- DO NOW^%DTC
- DO STF(.06,%,4)
- SET ACKXFT=$$HTIM^ACKQUTL()
- SET ACKMO=$$XDAT^ACKQUTL(ACKM)
- DO BUILD^ACKQWB
- QUIT
- +2 SET ACKXST=$$HTIM^ACKQUTL
- DO STF(.01,$$XDAT^ACKQUTL(ACKM),3)
- +3 DO NOW^%DTC
- DO STF(.04,%,4)
- DO STF(.05,$JOB,4)
- +4 QUIT
- DATHLP ;Extended help - select month for capitation report. (ACKQWL)
- +1 WRITE !?5,"Select a month, in the past, for which you wish to",!?5,"compile data for the A&SP Capitation Report."
- +2 QUIT