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

ECXUTLA.m

Go to the documentation of this file.
  1. ECXUTLA ;ALB/JAP - Utilities for Audit Reports ;3/9/16 16:18
  1. ;;3.0;DSS EXTRACTS;**8,14,112,154,161**;Dec 22, 1997;Build 6
  1. ;
  1. AUDIT(ECXHEAD,ECXERR,ECXARRAY,ECXAUD) ;set audit report parameters
  1. ; input
  1. ; ECXHEAD = extract HEADER CODE (required)
  1. ; (from file #727.1, field #7)
  1. ; ECXERR = passed-by-reference variable (required)
  1. ; ECXARRAY = passed-by-reference array (required)
  1. ; ECXAUD = 0/1 (optional)
  1. ; 0 --> extract audit (default)
  1. ; 1 --> SAS audit
  1. ; output
  1. ; ECXARRAY = array of audit parameters
  1. ; ECXARRAY("DEF") = ien of extract type in file #727.1
  1. ; ECXARRAY("TYPE") = print name for extract; field #7 in file #727.1
  1. ; ECXARRAY("EXTRACT") = ien of extract in file #727
  1. ; ECXARRAY("START") = start date for extract audit
  1. ; ECXARRAY("END") = end date for extract audit
  1. ; ECXARRAY("ERUN") = date on which extract was generated
  1. ; ECXARRAY("DIV") = ien of station if file #4
  1. ; error CODE
  1. ; ECXERR = 1, if input problem occurs
  1. ; 0, otherwise
  1. ;
  1. N X,Y,N,DA,DIC,DIQ,DIR,DTOUT,DUOUT,DIRUT,ECXDA,ECXTYPE,ECXSTART,ECXEND,ECXARR
  1. S ECXERR=0
  1. S N=$O(^ECX(727.1,"C",ECXHEAD,"")) S:N="" ECXERR=1
  1. Q:ECXERR
  1. S DIC="^ECX(727.1,",DIC(0)="NZ",X=N
  1. D ^DIC I Y=-1 S ECXERR=1 Q
  1. S ECXTYPE=$P(Y(0),U,7)_U_+Y K X,Y,DIC
  1. I $G(ECXAUD)=1,ECXHEAD'="DEN",ECXHEAD'="PRE",ECXHEAD'="RAD",ECXHEAD'="SUR" S ECXERR=1
  1. Q:ECXERR
  1. S DIC="^ECX(727,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,3)=$P(ECXTYPE,U),'$D(^(""PURG""))"
  1. D ^DIC
  1. I Y=-1!($G(DUOUT))!($G(DTOUT)) D:'$G(ECXAUD) RUN S ECXERR=1 Q ;154
  1. S DIC="^ECX(727,",(DA,ECXDA)=+Y,DR=".01;1;2;3;4;5;15;300",DIQ="ECXARR",DIQ(0)="IE"
  1. D EN^DIQ1
  1. W !!,?5,"Extract: ",ECXARR(727,ECXDA,2,"E")," #",ECXDA
  1. W !!,?5,"Start date: ",ECXARR(727,ECXDA,3,"E")
  1. W !,?5,"End date: ",ECXARR(727,ECXDA,4,"E")
  1. W !,?5,"# of Records: ",ECXARR(727,ECXDA,5,"E")
  1. I ECXHEAD="PRO" W !,?5,"Station: ",ECXARR(727,ECXDA,15,"E")
  1. ;if transmit date exists, then ask user if audit still needed
  1. I $L(ECXARR(727,ECXDA,300,"E"))>0 D
  1. .W !!,?5,"The extract which you have chosen to audit"
  1. .W !,?5,"was transmitted to Austin/DSS on ",ECXARR(727,ECXDA,300,"E"),".",!
  1. .S DIR(0)="Y",DIR("A")="Do you want to continue with this audit report",DIR("B")="NO" D ^DIR
  1. .S:$G(DIRUT) ECXERR=1 S:Y=0 ECXERR=1
  1. Q:ECXERR
  1. ;setup the return array
  1. S ECXARRAY("EXTRACT")=ECXARR(727,ECXDA,.01,"E"),ECXARRAY("DIV")=ECXARR(727,ECXDA,15,"I"),ECXARRAY("TYPE")=$P(ECXTYPE,U),ECXARRAY("DEF")=$P(ECXTYPE,U,2)
  1. S ECXARRAY("START")=ECXARR(727,ECXDA,3,"E"),ECXARRAY("END")=ECXARR(727,ECXDA,4,"E"),ECXARRAY("ERUN")=ECXARR(727,ECXDA,1,"E")
  1. ;determine date range only for extract audit reports
  1. I $G(ECXAUD)=0 D
  1. .S ECXSTART=ECXARRAY("START"),ECXEND=ECXARRAY("END") D RANGE^ECXUTLA(.ECXSTART,.ECXEND,.ECXERR)
  1. .I ECXERR K ECXARRAY
  1. .Q:ECXERR
  1. .S ECXARRAY("START")=ECXSTART,ECXARRAY("END")=ECXEND
  1. Q
  1. ;
  1. RANGE(ECXSTART,ECXEND,ECXERR) ;determine date range for extract audit report
  1. ; input
  1. ; ECXSTART = start date of extract in file #727 (required)
  1. ; passed by reference
  1. ; ECXEND = end date of extract in file #727 (required)
  1. ; passed by reference
  1. ; ECXERR = passed by reference (required)
  1. ; output
  1. ; ECXSTART = user selected start date
  1. ; ECXEND = user selected end date
  1. ; error CODE
  1. ; ECXERR = 1, if input problem occurs
  1. ; 0, otherwise
  1. ;
  1. ;
  1. ;convert dates to internal format
  1. N DATEA,DATEB,X,Y,%DT,DTOUT,OUT
  1. S (ECXERR,OUT)=0
  1. S X=ECXSTART D ^%DT S DATEA=Y
  1. S X=ECXEND D ^%DT S DATEB=Y
  1. ;allow user to select start date
  1. ;can't be less than ecxstart or greater than ecxend
  1. W !!,?5,"You can narrow the date range, if you wish.",!
  1. W !,?5,"The Start Date can't be earlier than ",ECXSTART,","
  1. W !,?5,"or later than ",ECXEND,".",!
  1. F Q:OUT!ECXERR D
  1. .S %DT="AEX",%DT("A")="Select Start Date: ",%DT("B")=ECXSTART,%DT(0)=DATEA
  1. .D ^%DT S:Y=-1 ECXERR=1 S:$G(DTOUT) ECXERR=1
  1. .Q:ECXERR
  1. .I Y>DATEB D Q
  1. ..W !,?5,"But that's later than ",ECXEND,"...try again.",!
  1. .S DATEA=Y,OUT=1
  1. I ECXERR K ECXSTART,ECXEND
  1. Q:ECXERR
  1. S Y=DATEA D DD^%DT S ECXSTART=Y
  1. ;allow user to select end date
  1. ;can't be less than ecxstart or greater than ecxend
  1. W !!,?5,"The End Date can't be earlier than ",ECXSTART
  1. W !,?5,"(the Start Date you selected), or later than ",ECXEND,".",!
  1. S OUT=0
  1. F Q:OUT!ECXERR D
  1. .S %DT="AEX",%DT("A")="Select End Date: ",%DT("B")=ECXEND,%DT(0)=-DATEB
  1. .D ^%DT S:Y=-1 ECXERR=1 S:$G(DTOUT) ECXERR=1
  1. .Q:ECXERR
  1. .I Y<DATEA D Q
  1. ..W !,?5,"But that's earlier than ",ECXSTART,"...try again.",!
  1. .S DATEB=Y,OUT=1
  1. I ECXERR K ECXSTART,ECXEND
  1. Q:ECXERR
  1. S Y=DATEB D DD^%DT S ECXEND=Y
  1. Q
  1. ;
  1. DEVICE(ZTRTN,ZTDESC,ZTSAVE) ;get print device and optionally task to background
  1. ; input
  1. ; ZTRTN = line^routine; task entry point (required)
  1. ; variable for %ZTLOAD
  1. ; ZTDESC = task description (required)
  1. ; variable for %ZTLOAD
  1. ; ZTSAVE = array; passed by reference (required)
  1. ; variables for %ZTLOAD
  1. ; output
  1. ; ZTSAVE = returns ZTSAVE("POP"),ZTSAVE("ZTSK")
  1. ;
  1. N POP,ZTSK
  1. S ZTSAVE("POP")=0,ZTSAVE("ZTSK")=0
  1. ;return ztsave("pop")=1 and quit if required input not available
  1. I '$L(ZTRTN)!('$L(ZTDESC))!('$D(ZTSAVE)) S ZTSAVE("POP")=1 Q
  1. ;get print device
  1. K IO("Q") S %ZIS="QM" D ^%ZIS
  1. S ZTSAVE("POP")=POP
  1. I POP D
  1. .W !,"No device selected...exiting.",!
  1. Q:POP
  1. I $D(IO("Q")) D
  1. .S ZTSAVE("ZTREQ")="@"
  1. .D ^%ZTLOAD
  1. .I $G(ZTSK)>0 D
  1. ..W !,"Request queued as Task #",ZTSK,".",!
  1. ..S ZTSAVE("ZTSK")=ZTSK
  1. ..S ZTSAVE("POP")=0
  1. .I '$G(ZTSK) D
  1. ..W !,"Request to queue cancelled...exiting.",!
  1. ..S ZTSAVE("ZTSK")=0
  1. ..S ZTSAVE("POP")=1
  1. Q
  1. ;
  1. WARDS(ECXALL,ECXDIV) ;get wards for selected divisions
  1. ; input
  1. ; ECXALL = 1/0 (optional)
  1. ; 1==> user selected all divisions OR
  1. ; facility is non-divisional
  1. ; 0==> user selected some divisions
  1. ; if ECXALL not defined, then assume 1
  1. ; ECXDIV = array of divisions selected (optional)
  1. ; passed by reference array containing
  1. ; selected divisions;
  1. ; if ECXALL=1, then ECXDIV array isn't
  1. ; required; information for all wards will be obtained
  1. ; if ECXALL=0, then only wards for divisions in ECXDIV
  1. ; output
  1. ; ^TMP($J,"ECXWARD", contains ward name, division, g&l order
  1. ; ^TMP($J,"ECXORDER", contains ward grouping info
  1. ;
  1. N IEN,WARD,ORDX,NAME,NM,ORDER,DIV,HIEN,GROUP,DATA,DEPT,NAMEDEPT
  1. K ^TMP($J,"ECXWARD"),^TMP($J,"ECXORDER")
  1. ;if ecxall not here, then set ecxall=1
  1. S:'$D(ECXALL) ECXALL=1 S:ECXALL="" ECXALL=1
  1. S ORDX=0,NM=""
  1. F S NM=$O(^DIC(42,"B",NM)) Q:NM="" S IEN=0 F S IEN=$O(^DIC(42,"B",NM,IEN)) Q:IEN="" D
  1. .S DIV=+$P(^DIC(42,IEN,0),U,11) Q:DIV=0
  1. .I ECXALL=0,'$D(ECXDIV(DIV)) Q
  1. .S (NAME,ORDER,DEPT)="",NAME=$P(^DIC(42,IEN,0),U,1),ORDER=+$P($G(^DIC(42,IEN,"ORDER")),U,1),DEPT=$P($G(^ECX(727.4,IEN,0)),U,2)
  1. .;'unordered' ward is probably inactive, but get basic data anyway
  1. .I ORDER=0 S ORDX=ORDX+1,ORDER="99999"_ORDX,ORDER=+ORDER
  1. .;get this ward's ien in file #44; file #727.802 & #727.808 use pointers to file #44
  1. .S HIEN=+$P($G(^DIC(42,IEN,44)),U,1) Q:HIEN=0
  1. .;if this is last ward in group, then get the group name
  1. .K GROUP I $D(^DIC(42,IEN,1,1,0)) S GROUP=$P(^DIC(42,IEN,1,1,0),U,1) I GROUP="" K GROUP
  1. .S ^TMP($J,"ECXWARD",HIEN)=ORDER_U_NAME_U_DIV_U_IEN_U_DEPT
  1. .I $D(GROUP) S ^TMP($J,"ECXWARD",HIEN,1)=GROUP
  1. ;after all wards in file #42 are processed, arrange by g&l order
  1. S HIEN=0
  1. F S HIEN=$O(^TMP($J,"ECXWARD",HIEN)) Q:HIEN="" S DATA=^TMP($J,"ECXWARD",HIEN) D
  1. .S ORDER=$P(DATA,U,1),NAME=$P(DATA,U,2),DIV=$P(DATA,U,3),DEPT=$P(DATA,U,5)
  1. .S NAMEDEPT=NAME S:DEPT]"" NAMEDEPT=NAME_" <"_DEPT_">"
  1. .S ^TMP($J,"ECXORDER",DIV,ORDER)=HIEN_U_NAMEDEPT_U
  1. .I $D(^TMP($J,"ECXWARD",HIEN,1)) S GROUP=^(1),^TMP($J,"ECXORDER",DIV,ORDER,1)=1_U_GROUP_U
  1. Q
  1. ;
  1. SASHEAD(ECXFL,ECXHEAD,ECXDIV,ECXARRAY,ECXPG,ECXTAB) ;header and page control
  1. ;
  1. ; ECXFL = feeder location (division) (required)
  1. ; ECXHEAD = extract header from file #727.1 (required)
  1. ; ECXDIV = array of divisions selected (required)
  1. ; ECXPG = page number (required)
  1. ; ECXTAB = tab location;
  1. ; allows for proper spacing in sub-header line (optional)
  1. ;
  1. N JJ,SS,LN
  1. S $P(LN,"-",80)=""
  1. I $G(ECXTAB)="" S ECXTAB=40
  1. I $E(IOST)="C" D
  1. .S SS=22-$Y F JJ=1:1:SS W !
  1. .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
  1. Q:QFLG
  1. W:$Y!($E(IOST)="C") @IOF S ECXPG=ECXPG+1
  1. W !,"SAS Audit Report for "_ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract"
  1. W !,"DSS Extract Log #: "_ECXARRAY("EXTRACT")
  1. W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
  1. W !,"Report Run Date/Time: "_ECXRUN
  1. I $D(ECXDIV(ECXFL)) W !,"Division/Site: "_$P(ECXDIV(ECXFL),U,2)_" ("_ECXFL_")",?68,"Page: "_ECXPG
  1. I '$D(ECXDIV(ECXFL)) W !,"Division/Site: "_"Unknown",?68,"Page: "_ECXPG
  1. I ECXHEAD="SUR" W !!,"Feeder",?12,"Feeder Location",!,"Location",?12,"Name",?ECXTAB,"Feeder Key",?68,"Quantity" ;161 Special header for SUR only
  1. I ECXHEAD'="SUR" W !!,"Feeder Location",?ECXTAB,"Feeder Key",?68,"Quantity" ;161 Non-SUR report header
  1. W !,LN,!
  1. Q
  1. ;
  1. RUN ;154 Section allows extract to be run from within audit report
  1. N DIR,X,Y,DTOUT,DUOUT,ECPACK,ECGRP,ECFILE,ECRTN,ECPIECE,ECVER,ECHEAD,ECXAUDIT
  1. W !
  1. S DIR("A",1)="You didn't select an existing extract log record number. Remember"
  1. S DIR("A",2)="the extract must be run first, before you can run this audit."
  1. S DIR("A",3)="If there is no log record number, run the extract from the Package Extracts"
  1. S DIR("A",4)="menu or if unavailable there, from here (you will be prompted to"
  1. S DIR("A",5)="queue the extract below)."
  1. S DIR("A",6)=""
  1. S DIR("A",7)="Remember that if you queue the extract to run from here"
  1. S DIR("A",8)="(the extract audit report menu), you may have to wait overnight for the"
  1. S DIR("A",9)="extract to finish. It must finish before you can pick its log record number"
  1. S DIR("A",10)="to run the extract audit."
  1. S DIR("A",11)=""
  1. S DIR("A")="Would you like to queue the "_ECXHEAD_" extract"
  1. S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
  1. Q:Y'=1
  1. S ECHEAD=ECXHEAD,ECXAUDIT=1
  1. D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
  1. I ECFILE="" Q
  1. D ^ECXTRAC,^ECXKILL
  1. Q