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