- ECXAPAS ;ALB/JAP - PAS Extract Audit Report ;Oct 16, 1997
- ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
- ;
- EN ;entry point for PAS extract audit report
- N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR
- S ECXERR=0
- ;ecxaud=0 for 'extract' audit
- S ECXHEAD="PAS",ECXAUD=0
- W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- ;select extract
- D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- Q:ECXERR
- ;currently, quasar does not accommodate multi-divisional sites
- S ECXALL=1
- D PAS^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- ;determine output device and queue if requested
- W !
- S ECXPGM="PROCESS^ECXAPAS",ECXDESC="PAS Extract Audit Report"
- S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")=""
- W !
- D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- I ECXSAVE("POP")=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- I ECXSAVE("ZTSK")=0 D
- .K ECXSAVE,ECXPGM,ECXDESC
- .D PROCESS^ECXAPAS
- I IO'=IO(0) D ^%ZISC
- D HOME^%ZIS
- D AUDIT^ECXKILL
- Q
- ;
- PROCESS ;process data in file #727.823
- N X,Y,W,DATA,DATE,DIV,IEN,QQFLG,CNT
- K ^TMP($J,"ECXAUD")
- S (CNT,QQFLG)=0
- S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF")
- S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
- ;get run date in external format
- D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
- ;get extract records in date range
- S IEN="" F S IEN=$O(^ECX(727.823,"AC",ECXEXT,IEN)) Q:IEN="" D Q:QQFLG
- .S DATA=^ECX(727.823,IEN,0),DATE=$P(DATA,U,9),DIV=$P(DATA,U,4)
- .;currently the 4th piece of extract record is always null for pai
- .S:DIV="" DIV=1
- .;convert free text date to fm internal format date
- .S $E(DATE,1,2)=$E(DATE,1,2)-17
- .Q:$L(DATE)<7 Q:(DATE<ECXSTART) Q:(DATE>ECXEND)
- .I $D(ECXDIV(DIV)) D
- ..I '$D(^TMP($J,"ECXAUD",DIV)) S ^TMP($J,"ECXAUD",DIV)=0
- ..S ^(DIV)=^TMP($J,"ECXAUD",DIV)+1,CNT=CNT+1
- ..I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ
- ;print the report
- D PRINT
- D AUDIT^ECXKILL
- Q
- ;
- PRINT ;print pai data by site
- N JJ,SS,LN,P,DIV,DIVNM,GTOT,PG,QFLG,DIR,DIRUT,DTOUT,DUOUT
- U IO
- S (QFLG,PG)=0,$P(LN,"-",80)="",DIV=""
- F S DIV=$O(ECXDIV(DIV)) Q:DIV="" D Q:QFLG
- .S DIVNM=$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")" D HEADER
- .S GTOT=$G(^TMP($J,"ECXAUD",DIV))
- .D:($Y+3>IOSL) HEADER Q:QFLG
- .W !!,"Total Patient Assessments extracted for date range: "_GTOT
- I $E(IOST)'="C" D
- .W @IOF S PG=PG+1
- .W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- .W !,"DSS Extract Log #: "_ECXEXT
- .W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- .W !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
- .W !!,LN,!!
- .S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ
- I $E(IOST)="C",'QFLG D
- .S SS=22-$Y F JJ=1:1:SS W !
- .S DIR(0)="E" W ! D ^DIR K DIR
- Q
- ;
- N JJ,SS
- 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 PG=PG+1
- W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- W !,"DSS Extract Log #: "_ECXARRAY("EXTRACT")
- W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- W !,"Report Run Date/Time: "_ECXRUN
- W !,"DSS Site: "_$P(ECXDIV(DIV),U,2)_" ("_$P(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG
- W !,LN,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXAPAS 3440 printed Mar 13, 2025@20:56:44 Page 2
- ECXAPAS ;ALB/JAP - PAS Extract Audit Report ;Oct 16, 1997
- +1 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
- +2 ;
- EN ;entry point for PAS extract audit report
- +1 NEW %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR
- +2 SET ECXERR=0
- +3 ;ecxaud=0 for 'extract' audit
- +4 SET ECXHEAD="PAS"
- SET ECXAUD=0
- +5 WRITE !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- +6 ;select extract
- +7 DO AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- +8 if ECXERR
- QUIT
- +9 ;currently, quasar does not accommodate multi-divisional sites
- +10 SET ECXALL=1
- +11 DO PAS^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
- +12 IF ECXERR=1
- Begin DoDot:1
- +13 WRITE !!,?5,"Try again later... exiting.",!
- +14 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +15 ;determine output device and queue if requested
- +16 WRITE !
- +17 SET ECXPGM="PROCESS^ECXAPAS"
- SET ECXDESC="PAS Extract Audit Report"
- +18 SET ECXSAVE("ECXHEAD")=""
- SET ECXSAVE("ECXALL")=""
- SET ECXSAVE("ECXDIV(")=""
- SET ECXSAVE("ECXARRAY(")=""
- +19 WRITE !
- +20 DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- +21 IF ECXSAVE("POP")=1
- Begin DoDot:1
- +22 WRITE !!,?5,"Try again later... exiting.",!
- +23 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +24 IF ECXSAVE("ZTSK")=0
- Begin DoDot:1
- +25 KILL ECXSAVE,ECXPGM,ECXDESC
- +26 DO PROCESS^ECXAPAS
- End DoDot:1
- +27 IF IO'=IO(0)
- DO ^%ZISC
- +28 DO HOME^%ZIS
- +29 DO AUDIT^ECXKILL
- +30 QUIT
- +31 ;
- PROCESS ;process data in file #727.823
- +1 NEW X,Y,W,DATA,DATE,DIV,IEN,QQFLG,CNT
- +2 KILL ^TMP($JOB,"ECXAUD")
- +3 SET (CNT,QQFLG)=0
- +4 SET ECXEXT=ECXARRAY("EXTRACT")
- SET ECXDEF=ECXARRAY("DEF")
- +5 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +6 ;get run date in external format
- +7 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET ECXRUN=Y
- +8 ;get extract records in date range
- +9 SET IEN=""
- FOR
- SET IEN=$ORDER(^ECX(727.823,"AC",ECXEXT,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +10 SET DATA=^ECX(727.823,IEN,0)
- SET DATE=$PIECE(DATA,U,9)
- SET DIV=$PIECE(DATA,U,4)
- +11 ;currently the 4th piece of extract record is always null for pai
- +12 if DIV=""
- SET DIV=1
- +13 ;convert free text date to fm internal format date
- +14 SET $EXTRACT(DATE,1,2)=$EXTRACT(DATE,1,2)-17
- +15 if $LENGTH(DATE)<7
- QUIT
- if (DATE<ECXSTART)
- QUIT
- if (DATE>ECXEND)
- QUIT
- +16 IF $DATA(ECXDIV(DIV))
- Begin DoDot:2
- +17 IF '$DATA(^TMP($JOB,"ECXAUD",DIV))
- SET ^TMP($JOB,"ECXAUD",DIV)=0
- +18 SET ^(DIV)=^TMP($JOB,"ECXAUD",DIV)+1
- SET CNT=CNT+1
- +19 IF $DATA(ZTQUEUED)
- IF (CNT>499)
- IF '(CNT#500)
- IF $$S^%ZTLOAD
- SET QQFLG=1
- SET ZTSTOP=1
- KILL ZTREQ
- End DoDot:2
- End DoDot:1
- if QQFLG
- QUIT
- +20 ;print the report
- +21 DO PRINT
- +22 DO AUDIT^ECXKILL
- +23 QUIT
- +24 ;
- PRINT ;print pai data by site
- +1 NEW JJ,SS,LN,P,DIV,DIVNM,GTOT,PG,QFLG,DIR,DIRUT,DTOUT,DUOUT
- +2 USE IO
- +3 SET (QFLG,PG)=0
- SET $PIECE(LN,"-",80)=""
- SET DIV=""
- +4 FOR
- SET DIV=$ORDER(ECXDIV(DIV))
- if DIV=""
- QUIT
- Begin DoDot:1
- +5 SET DIVNM=$PIECE(ECXDIV(DIV),U,2)_" ("_$PIECE(ECXDIV(DIV),U,3)_")"
- DO HEADER
- +6 SET GTOT=$GET(^TMP($JOB,"ECXAUD",DIV))
- +7 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- +8 WRITE !!,"Total Patient Assessments extracted for date range: "_GTOT
- End DoDot:1
- if QFLG
- QUIT
- +9 IF $EXTRACT(IOST)'="C"
- Begin DoDot:1
- +10 WRITE @IOF
- SET PG=PG+1
- +11 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +12 WRITE !,"DSS Extract Log #: "_ECXEXT
- +13 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +14 WRITE !,"Report Run Date/Time: "_ECXRUN,?68,"Page: ",PG
- +15 WRITE !!,LN,!!
- +16 SET DIC="^ECX(727.1,"
- SET DA=ECXARRAY("DEF")
- SET DR="1"
- DO EN^DIQ
- End DoDot:1
- +17 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- Begin DoDot:1
- +18 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +19 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- +20 QUIT
- +21 ;
- +1 NEW JJ,SS
- +2 IF $EXTRACT(IOST)="C"
- Begin DoDot:1
- +3 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +4 IF PG>0
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- if 'Y
- SET QFLG=1
- End DoDot:1
- +5 if QFLG
- QUIT
- +6 if $Y!($EXTRACT(IOST)="C")
- WRITE @IOF
- SET PG=PG+1
- +7 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +8 WRITE !,"DSS Extract Log #: "_ECXARRAY("EXTRACT")
- +9 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +10 WRITE !,"Report Run Date/Time: "_ECXRUN
- +11 WRITE !,"DSS Site: "_$PIECE(ECXDIV(DIV),U,2)_" ("_$PIECE(ECXDIV(DIV),U,3)_")",?68,"Page: "_PG
- +12 WRITE !,LN,!
- +13 QUIT
