Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACKQWL

ACKQWL.m

Go to the documentation of this file.
  1. ACKQWL ;AUG/JLTP BIR/PTD-Compile A&SP Capitation Data ; [ 05/21/96 11:15 ]
  1. ;;3.0;QUASAR;;Feb 11, 2000
  1. ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
  1. OPTN ;Introduce option.
  1. W @IOF,!,"This option compiles the data for the A&SP Capitation Report.",!
  1. D GETDT G:$D(DIRUT) EXIT D INIT S ACKMAN=1,ACKDUZ=DUZ
  1. S ACKST=$$STATUS() I 'ACKST W !,"Can't continue: ",$P(ACKST,U,3) G EXIT
  1. BKG ;Queue process to run in the background.
  1. S ZTRTN="DQ^ACKQWL",ZTIO="",ZTSAVE("ACK*")=""
  1. S ZTDESC="QUASAR - Compile A&SP Capitation Data" D ^%ZTLOAD W:$D(ZTSK) !,"Data generation queued to run in the background." G EXIT
  1. DQ ;Entry point when queued.
  1. N CPT,ICD
  1. S:'$D(ACKM) ACKM=$$LM(DT) D:'$D(ACKDA) INIT
  1. S ACKST=$$STATUS() I 'ACKST D:'$D(ACKMAN) ABORT^ACKQWB(ACKST) G EXIT
  1. I $P(ACKST,U,2)=1 D CREATE G:$D(DIRUT) EXIT
  1. D LOG("BEGIN"),^ACKQWL1,LOG("END")
  1. EXIT ;ALWAYS EXIT HERE
  1. K ACKBFY,ACKCP,ACKCPP,ACKCPT,ACKD,ACKDA,ACKDUZ,ACKEM,ACKICP,ACKICD,ACKM,ACKMAN,ACKMO,ACKNU,ACKNV,ACKST,ACKSTOP,ACKV,ACKXFT,ACKXST,ACKZIP
  1. K %X,%Y,D0,DA,DFN,DIE,DIRUT,DTOUT,DUOUT,DR,I,VAERR,VAPA,X,XMZ,Y,ZTSK
  1. K ^TMP("ACKQWL",$J)
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. GETDT ;Select month for report.
  1. N DIR,X,Y
  1. GDT1 S DIR(0)="D^::APE",DIR("A")="Select Month & Year"
  1. S DIR("B")=$$XDAT^ACKQUTL($$LM(DT)),DIR("?")="^D HELP^%DTC"
  1. S DIR("??")="^D DATHLP^ACKQWL" D ^DIR Q:$D(DIRUT) S ACKM=$E(Y,1,5)_"00"
  1. I ACKM>DT W !,$C(7),"Can't run capitation report for future months!" G GDT1
  1. Q
  1. INIT ;Initialize important variables.
  1. N MON
  1. S MON=$E(ACKM,1,5),ACKEM=MON_"99",ACKDA=+$$SITE^VASITE()_MON
  1. S ACKBFY=$$BFY^ACKQUTL(ACKM)
  1. Q
  1. STATUS() ;Find status of WORKLOAD file (#509850.7).
  1. I '$D(^ACK(509850.7,ACKDA,0)) D STA(1) Q X
  1. I $P(^ACK(509850.7,ACKDA,0),U,8) D STA(6) Q X
  1. I $P(^ACK(509850.7,ACKDA,0),U,6) D STA($S($D(^(4)):4,1:3)) Q X
  1. I $P(^ACK(509850.7,ACKDA,0),U,4) D STA(5) Q X
  1. I $D(^ACK(509850.7,ACKDA,4,0)) D STA(2) Q X
  1. Q 1
  1. STA(O) S X=$P($T(STA+O),";;",2) D:$P(X,U)="?" STAQES Q
  1. ;;1^1^Capitation Report Not Generated - CDR Not Completed
  1. ;;1^2^Capitation Report Not Generated - CDR Completed
  1. ;;?^3^Capitation Report Already Generated - CDR Not Completed
  1. ;;?^4^Capitation Report Already Generated - CDR Completed
  1. ;;0^5^Capitation Report Already Running - Not Completed
  1. ;;0^6^Capitation Report Already Verified
  1. STAQES ;If interactive, ask if ok.
  1. I $D(ZTQUEUED) S $P(X,U)=1 Q
  1. N ACKX,DIR,Y,DIRUT,DUOUT,DTOUT S ACKX=X
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Continue",DIR("A",1)=$P(X,U,3)
  1. S DIR("?")="Answer Y for YES or N for NO."
  1. 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."""
  1. D ^DIR S X=ACKX,$P(X,U)=$S($D(DIRUT):0,1:+Y) D:X CLEAN
  1. Q
  1. LM(X) ;Find month previous to X.
  1. N M,D,Y S M=$E(X,4,5),D=$E(X,6,7),Y=$E(X,1,3),M=M-1
  1. S:M<1 M=12,Y=Y-1 S:M<10 M="0"_M
  1. Q Y_M_"00"
  1. CREATE ;Create WORKLOAD file entry.
  1. S DIC="^ACK(509850.7,",DIC(0)="L",DLAYGO=509850.7,ACKLAYGO="",X=ACKM,DINUM=ACKDA
  1. K DD,DO D FILE^DICN S:Y<0 DIRUT=1
  1. Q
  1. CLEAN ;Clean out previously generated data for month.
  1. D WAIT^DICD N X
  1. F X=.04,.05,.06 D STF(X,"@",3)
  1. F X=1,2,3 D MDEL(X)
  1. Q
  1. STF(F,V,S) ;Use 'S' slash stuff to enter value 'V' in field 'F'.
  1. N DIE,DR,DA,SL,X,Y
  1. S SL="",$P(SL,"/",S)="/",DIE="^ACK(509850.7,",DA=ACKDA,DR=F_SL_V D ^DIE Q
  1. MDEL(FLD) ;Delete all entries from multiple field FLD.
  1. S DIK="^ACK(509850.7,"_ACKDA_","_FLD_",",DA(1)=ACKDA,SUB=0 D
  1. .F S SUB=$O(^ACK(509850.7,ACKDA,FLD,SUB)) Q:'SUB S DA=SUB D ^DIK
  1. K DA,DIK,SUB
  1. Q
  1. LOG(X) ;Log the task's start time, end time, and other info.
  1. I X="END" D NOW^%DTC D STF(.06,%,4) S ACKXFT=$$HTIM^ACKQUTL(),ACKMO=$$XDAT^ACKQUTL(ACKM) D BUILD^ACKQWB Q
  1. S ACKXST=$$HTIM^ACKQUTL D STF(.01,$$XDAT^ACKQUTL(ACKM),3)
  1. D NOW^%DTC,STF(.04,%,4),STF(.05,$J,4)
  1. Q
  1. DATHLP ;Extended help - select month for capitation report. (ACKQWL)
  1. W !?5,"Select a month, in the past, for which you wish to",!?5,"compile data for the A&SP Capitation Report."
  1. Q