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

ACKQDWL.m

Go to the documentation of this file. 
  1. ACKQDWL ;AUG/JLTP BIR/PTD HCIOFO/BH-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.  ;
  1. OPTN ;  Introduce option.
  1.  W @IOF,!,"This option compiles the data for the A&SP Capitation Report.",!
  1. DIV ; select Division (user may select one/many/ALL)
  1.  S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"IA") G:'ACKDIV EXIT
  1.  ;  get month to be compiled
  1.  D GETDT G:$D(DIRUT) EXIT
  1.  ;  initialise other variables
  1.  D INIT S ACKMAN=1,ACKDUZ=DUZ
  1.  ;
  1.  ;  Check the status of the workload file
  1.  S ACKWLMSG=$$WLSTATUS^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
  1.  ;  If status does not allow us to run, then exit
  1.  S ACKSTAT=$$STAQES1^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
  1.  ;
  1.  I 'ACKSTAT!(ACKSTAT="^") D EXIT G DIV
  1.  ;                      
  1. BKG ;  Queue process to run in the background.
  1.  W !!,"QUASAR - Compile A&SP Capitation Data ",!
  1.  ;
  1.  S ZTRTN="DQ^ACKQDWL",ZTIO="",ZTSAVE("ACK*")=""
  1.  S ZTDESC="QUASAR - Compile A&SP Capitation Data" D ^%ZTLOAD
  1.  W:$D(ZTSK) !,"Data generation queued to run in the background."
  1.  G EXIT
  1.  ;
  1. DQ ;  Entry point when queued.
  1.  N CPT,ICD
  1.  S:'$D(ACKM) ACKM=$$LM(DT) D:'$D(ACKDA) INIT
  1.  S ACKWLMSG=$$WLSTATUS^ACKQDWLU(ACKDA,.ACKDIV,.ACKWLMSG)
  1.  S ACKSTAT=$$STAQES^ACKQDWLU(ACKWLMSG) I 'ACKSTAT D:'$D(ACKMAN) ABORT^ACKQDWB(ACKWLMSG) G EXIT
  1.  I ACKSTAT=2 D CREATE^ACKQDWLU(ACKDA,ACKM,.ACKDIV) G:$D(DIRUT) EXIT
  1.  D BEGIN
  1.  D ^ACKQDWL1
  1.  D END
  1.  ;
  1.  ;
  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),ACKXSDTE,ACKXEDTE,ACKDIV
  1.  K ACKSTAT,ACKST,ACKK1,ACKN,ACKDEF,ACKVDVN,ACKX,DIVIEN,DIVARR
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  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^ACKQDWL"
  1.  D ^DIR Q:$D(DIRUT)
  1.  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.  ;
  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.  ;
  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.  ;
  1. DATHLP ;  Extended help - select month for capitation report. (ACKQWL)
  1.  W !?5,"Enter a date, in the past, for which you wish to",!?5,"compile data for the A&SP Capitation Report."
  1.  Q
  1.  ;
  1. END ;  Set END date field into header for Division and Date  
  1.  N ACKARR
  1.  D NOW^%DTC
  1.  S DIVNUM=""
  1.  F  S DIVNUM=$O(ACKDIV(DIVNUM)) Q:DIVNUM=""  D
  1.  . S DIVIEN=$P(ACKDIV(DIVNUM),U,1)
  1.  . S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.04)=%
  1.  D FILE^DIE("K","ACKARR")
  1.  D NOW^%DTC
  1.  S Y=X D DD^%DT S ACKXEDTE=Y
  1.  S ACKXFT=$$HTIM^ACKQUTL(),ACKMO=$$XDAT^ACKQUTL(ACKM) D BUILD^ACKQDWB
  1.  K ACKDIV
  1.  Q
  1.  ;
  1. BEGIN ;  Set START date and Job # into header record for Division and date
  1.  N ACKARR
  1.  D NOW^%DTC
  1.  S Y=X D DD^%DT S ACKXSDTE=Y
  1.  S ACKXST=$$HTIM^ACKQUTL
  1.  S DIVNUM=""
  1.  F  S DIVNUM=$O(ACKDIV(DIVNUM)) Q:DIVNUM=""  D
  1.  . S DIVIEN=$P(ACKDIV(DIVNUM),U,1)
  1.  . S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.02)=%
  1.  . S ACKARR(509850.75,DIVIEN_","_ACKDA_",",5.03)=$J
  1.  D FILE^DIE("K","ACKARR")
  1.  Q
  1.  ;
  1.  ;