- ECXANUT ;ALB/JRC - NUT Extract Audit Report ; 7/24/09 11:28am
- ;;3.0;DSS EXTRACTS;**105,111,119**;Dec 22, 1997;Build 19
- Q
- EN ;entry point for NUT extract audit report
- N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,SCRNARR,REPORT
- N SCRNARR,ECXERR,ECXHEAD,ECXAUD,ECXARRAY,STATUS,FLAG,ECXALL,TMP
- N ZTQUEUED,ZTSTOP
- S SCRNARR="^TMP(""ECX"",$J,""SCRNARR"")"
- K @SCRNARR@("DIVISION")
- S (ECXERR,FLAG)=0
- ;ecxaud=0 for 'extract' audit
- S ECXHEAD="NUT",ECXAUD=0
- W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- ;select extract
- D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- Q:ECXERR
- W !!
- ;select divisions/sites; all divisions if ecxall=1
- S ECXERR=$$NUT^ECXDVSN()
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .K @SCRNARR@("DIVISION")
- .D AUDIT^ECXKILL
- S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
- W !
- ;prompt for report type, (s)ummary or (d)etail
- S REPORT=$$REPORT() Q:FLAG
- ;if detail selected, prompt for (i)npatient, (o)utpatient or (b)oth
- I REPORT="D" S STATUS=$$STATUS() Q:FLAG
- ;determine output device and queue if requested
- S ECXPGM="PROCESS^ECXANUT",ECXDESC="NUT Extract Audit Report"
- S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("STATUS")="",ECXSAVE("REPORT")="",ECXSAVE("FLAG")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")="",ECXSAVE("SCRNARR")="",TMP=$$OREF^DILF(SCRNARR),ECXSAVE(TMP)=""
- W !
- D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- I ECXSAVE("POP")=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .K @SCRNARR@("DIVISION")
- .D AUDIT^ECXKILL
- I ECXSAVE("ZTSK")=0 D
- .K ECXSAVE,ECXPGM,ECXDESC
- .D PROCESS^ECXANUT
- I IO'=IO(0) D ^%ZISC
- D HOME^%ZIS
- D AUDIT^ECXKILL
- Q
- ;
- PROCESS ;process data in file #727.832 and store in ^tmp global
- N %,ARRAY,ECXEXT,ECXDEF,X,ECXSTART,ECXEND,ECXRUN,IEN,NODE0,NODE1,DATE,FKEY,DIV,OBS,DLTYPE,DFL,ENC,FPD,FPF,I,PFK,DLDIV
- S ARRAY="^TMP($J,""ECXORDER"")"
- 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 records in date range and set values
- S IEN=0 F S IEN=$O(^ECX(727.832,"AC",ECXEXT,IEN)) Q:IEN="" D Q:FLAG
- .S NODE0=$G(^ECX(727.832,IEN,0)),NODE1=$G(^(1))
- .S DATE=$P(NODE0,U,9),STAT=$P(NODE0,U,8),PFK=$P(NODE1,U,8),DIV=$P(NODE1,U,5),OBS=$P(NODE1,U,2),DLT=$P(NODE1,U,10),FPD=$P(NODE1,U,6),FPF=$P(NODE1,U,9),ENC=$P(NODE1,U,4),DFL=$P(NODE1,U,11),DLDIV=$P(NODE1,U,7)
- .;filter out divisions if not all selected
- .Q:$G(@SCRNARR@("DIVISION"))'=1&'$D(@SCRNARR@("DIVISION",+$G(DIV)))
- .;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)
- .;Update totals and store in ^tmp global, add count for each unique
- .;feeder key/delivery location. Under each unique key create a record
- .;for each unique combination of in/out code, observation status
- .;save it in ^tmp global for later use.
- .I REPORT="S" D
- ..F I="DIV","DLT","STAT","OBS","PFK" I @I="" S @I="UNKNOWN"
- ..;Increment delivery location type (dlt) counter
- ..;S ^TMP($J,"ECXDLT",DIV,DLT,STAT,OBS)=$G(^TMP($J,"ECXDLT",DIV,DLT,STAT,OBS))+1
- ..S ^TMP($J,DIV,"ECXDLT",DLT,STAT,OBS)=$G(^TMP($J,DIV,"ECXDLT",DLT,STAT,OBS))+1
- ..;Increment feeder key (fk) counter
- ..;S ^TMP($J,"ECXFKEY",DIV,PFK,STAT,OBS)=$G(^TMP($J,"ECXFKEY",DIV,PFK,STAT,OBS))+1
- ..S ^TMP($J,DIV,"ECXFKEY",PFK,STAT,OBS)=$G(^TMP($J,DIV,"ECXFKEY",PFK,STAT,OBS))+1
- .I REPORT="D" D
- ..F I="FPD","FPF","PFK","OBS","ENC" I $G(@I)="" S @I="UNKNOWN"
- ..F I="DIV","DLDIV","DFL","DLT" I $G(@I)="" S @I="UNK"
- ..;Check patient status and screen if necessary
- ..Q:STATUS'="B"&(STATUS'=STAT)
- ..;Increment fpd, fpf, pfk, obs counter
- ..S ^TMP($J,DIV,FPD,FPF,PFK,OBS)=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS))+1
- ..;Increment div, dfl, dlt counter
- ..S ^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT)=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT))+1
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- D PRINT
- D AUDIT^ECXKILL
- Q
- ;
- PRINT ;print report
- N FLAG,PG,LN,KEY,DLT,STAT,OBS,TOTAL,TCNT,CNT,PDLT
- U IO
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- S (FLAG,PG)=0,$P(LN,"-",80)=""
- I '$D(^TMP($J)) D Q
- .S DIV=0 F S DIV=$O(@SCRNARR@("DIVISION",DIV)) Q:'DIV D
- ..D HEADER
- ..W !
- ..W !,"**************************************************"
- ..W !,"* No data available for this patient division. *"
- ..W !,"**************************************************"
- I REPORT="S" D
- .S DIV="" F S DIV=$O(^TMP($J,DIV)) Q:DIV']"" D Q:FLAG
- ..D HEADER Q:FLAG
- ..S KEY="" F S KEY=$O(^TMP($J,DIV,KEY)) Q:KEY']"" D Q:FLAG
- ...S PFK="" F S PFK=$O(^TMP($J,DIV,KEY,PFK)) Q:PFK']"" D Q:FLAG
- ....D SUB Q:FLAG
- ....S STAT="" F S STAT=$O(^TMP($J,DIV,KEY,PFK,STAT)) Q:STAT']"" D Q:FLAG
- .....S OBS="" F S OBS=$O(^TMP($J,DIV,KEY,PFK,STAT,OBS)) Q:OBS']"" D Q:FLAG
- ......S TOTAL=$P(^TMP($J,DIV,KEY,PFK,STAT,OBS),U)
- ......;Print by delivery location type (feeder key)
- ......D:($Y+3>IOSL) HEADER,SUB Q:FLAG
- ......W !,?1,STAT,?12,$S(OBS="NO":" NO",1:"YES"),?30,TOTAL
- ;detail report print
- I REPORT="D" D
- .S DIV="" F S DIV=$O(^TMP($J,DIV)) Q:DIV']"" D Q:FLAG
- ..S FPD="" F S FPD=$O(^TMP($J,DIV,FPD)) Q:FPD']"" D Q:FLAG
- ...S FPF="" F S FPF=$O(^TMP($J,DIV,FPD,FPF)) Q:FPF']"" D Q:FLAG
- ....S PFK="" F S PFK=$O(^TMP($J,DIV,FPD,FPF,PFK)) Q:PFK']"" D Q:FLAG
- .....S OBS="" F S OBS=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS)) Q:OBS']"" D Q:FLAG
- ......S TCNT=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS))
- ......D HEADER
- ......S ENC="" F S ENC=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC)) Q:ENC']"" D Q:FLAG
- .......S DLDIV="" F S DLDIV=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV)) Q:DLDIV']"" D Q:FLAG
- ........S DFL="" F S DFL=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL)) Q:DFL']"" D Q:FLAG
- .........S DLT="" F S DLT=$O(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT)) Q:DLT']"" D Q:FLAG
- ..........S CNT=$G(^TMP($J,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT))
- ..........S PDLT=DLT
- ..........I ENC["I",DLT="UNK" S PDLT=$S(PFK["ST ORDER":"N/A",PFK["SUPP FEED":"N/A",PFK["TF":"N/A",1:DLT)
- ..........W !,?1,$E(ENC,1,25),?28,DLDIV,?42,DFL,?60,PDLT,?71,CNT
- ..........D:($Y+3>IOSL) HEADER Q:FLAG
- Q
- ;
- N JJ,SS,DIR,DIRUT,DTOUT,DUOUT,DSSID
- 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 FLAG=1
- Q:FLAG
- S DSSID=$S($G(DIV):$$NNT^XUAF4(DIV),1:"UNKNOWN^^")
- W:$Y!($E(IOST)="C") @IOF S PG=PG+1
- W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"_$S(REPORT="S":" (Summary)",1:" (Detail)")
- W !,"DSS Extract Log #: "_ECXEXT
- W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- W !,"Report Run Date/Time: "_ECXRUN
- W !,"Patient Division: "_$P(DSSID,U)_$S($P(DSSID,U,2)'="":" ("_$P(DSSID,U,2)_")",1:""),?68,$S(REPORT="S":"Page: "_PG,1:"")
- ;Detailed report sub-header
- Q:'$D(^TMP($J))
- I REPORT="D" D
- .W !,"Patient Status: "_$S(STATUS="I":"Inpatient",STATUS="O":"Outpatient",1:"Inpatient and Outpatient"),?68,"Page: "_PG
- .W !!,"Prod Div: "_FPD_" Prod Fac: "_FPF_" Prod FK: "_PFK_" OBS: "_OBS,?60," TOTAL: ",TCNT
- .W !,?1,"Encounter Number",?28,"Del Div",?42,"Del Feed Loc",?60,"Loc Type",?71,"Count"
- Q
- SUB ;Summary report sub-header
- I REPORT="S" D
- .W !!,"FEEDER KEY: "_PFK
- .W !!,"I/O",?12,"OBS",?30,"TOTAL"
- Q
- ;
- REPORT() ;Select report type
- ;
- ; Output - S = summary
- ; D = detail
- ;Init variables
- N DIR,DIRUT,DUOUT,X,Y
- S DIR(0)="S^S:SUMMARY;D:DETAIL"
- S DIR("A")="Select type of report"
- S DIR("?",1)="S = Summary"
- S DIR("?",2)="D = Detail"
- D ^DIR
- I $D(DIRUT)!$D(DUOUT) S FLAG=1 Q ""
- Q Y
- ;
- STATUS() ;Select patient status for report
- ;
- ; Output - I = inpatient
- ; O = outpatient
- ; B = both
- ;Init variables
- N DIR,DIRUT,DUOUT,X,Y
- S DIR(0)="S^I:INPATIENT;O:OUTPATIENT;B:BOTH"
- S DIR("A")=" report?"
- S DIR("A")="Select patient status for report"
- S DIR("?",1)="I = Inpatient"
- S DIR("?",2)="O = Outpatient"
- S DIR("?",3)="B = Both"
- D ^DIR
- I $D(DIRUT)!$D(DUOUT) S FLAG=1 Q ""
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXANUT 8224 printed Jan 18, 2025@02:53:17 Page 2
- ECXANUT ;ALB/JRC - NUT Extract Audit Report ; 7/24/09 11:28am
- +1 ;;3.0;DSS EXTRACTS;**105,111,119**;Dec 22, 1997;Build 19
- +2 QUIT
- EN ;entry point for NUT extract audit report
- +1 NEW %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,DIRUT,DTOUT,DUOUT,SCRNARR,REPORT
- +2 NEW SCRNARR,ECXERR,ECXHEAD,ECXAUD,ECXARRAY,STATUS,FLAG,ECXALL,TMP
- +3 NEW ZTQUEUED,ZTSTOP
- +4 SET SCRNARR="^TMP(""ECX"",$J,""SCRNARR"")"
- +5 KILL @SCRNARR@("DIVISION")
- +6 SET (ECXERR,FLAG)=0
- +7 ;ecxaud=0 for 'extract' audit
- +8 SET ECXHEAD="NUT"
- SET ECXAUD=0
- +9 WRITE !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- +10 ;select extract
- +11 DO AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- +12 if ECXERR
- QUIT
- +13 WRITE !!
- +14 ;select divisions/sites; all divisions if ecxall=1
- +15 SET ECXERR=$$NUT^ECXDVSN()
- +16 IF ECXERR=1
- Begin DoDot:1
- +17 WRITE !!,?5,"Try again later... exiting.",!
- +18 KILL @SCRNARR@("DIVISION")
- +19 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +20 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +21 WRITE !
- +22 ;prompt for report type, (s)ummary or (d)etail
- +23 SET REPORT=$$REPORT()
- if FLAG
- QUIT
- +24 ;if detail selected, prompt for (i)npatient, (o)utpatient or (b)oth
- +25 IF REPORT="D"
- SET STATUS=$$STATUS()
- if FLAG
- QUIT
- +26 ;determine output device and queue if requested
- +27 SET ECXPGM="PROCESS^ECXANUT"
- SET ECXDESC="NUT Extract Audit Report"
- +28 SET ECXSAVE("ECXHEAD")=""
- SET ECXSAVE("ECXALL")=""
- SET ECXSAVE("STATUS")=""
- SET ECXSAVE("REPORT")=""
- SET ECXSAVE("FLAG")=""
- SET ECXSAVE("ECXDIV(")=""
- SET ECXSAVE("ECXARRAY(")=""
- SET ECXSAVE("SCRNARR")=""
- SET TMP=$$OREF^DILF(SCRNARR)
- SET ECXSAVE(TMP)=""
- +29 WRITE !
- +30 DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- +31 IF ECXSAVE("POP")=1
- Begin DoDot:1
- +32 WRITE !!,?5,"Try again later... exiting.",!
- +33 KILL @SCRNARR@("DIVISION")
- +34 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +35 IF ECXSAVE("ZTSK")=0
- Begin DoDot:1
- +36 KILL ECXSAVE,ECXPGM,ECXDESC
- +37 DO PROCESS^ECXANUT
- End DoDot:1
- +38 IF IO'=IO(0)
- DO ^%ZISC
- +39 DO HOME^%ZIS
- +40 DO AUDIT^ECXKILL
- +41 QUIT
- +42 ;
- PROCESS ;process data in file #727.832 and store in ^tmp global
- +1 NEW %,ARRAY,ECXEXT,ECXDEF,X,ECXSTART,ECXEND,ECXRUN,IEN,NODE0,NODE1,DATE,FKEY,DIV,OBS,DLTYPE,DFL,ENC,FPD,FPF,I,PFK,DLDIV
- +2 SET ARRAY="^TMP($J,""ECXORDER"")"
- +3 SET ECXEXT=ECXARRAY("EXTRACT")
- SET ECXDEF=ECXARRAY("DEF")
- +4 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +5 ;get run date in external format
- +6 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET ECXRUN=Y
- +7 ;get records in date range and set values
- +8 SET IEN=0
- FOR
- SET IEN=$ORDER(^ECX(727.832,"AC",ECXEXT,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +9 SET NODE0=$GET(^ECX(727.832,IEN,0))
- SET NODE1=$GET(^(1))
- +10 SET DATE=$PIECE(NODE0,U,9)
- SET STAT=$PIECE(NODE0,U,8)
- SET PFK=$PIECE(NODE1,U,8)
- SET DIV=$PIECE(NODE1,U,5)
- SET OBS=$PIECE(NODE1,U,2)
- SET DLT=$PIECE(NODE1,U,10)
- SET FPD=$PIECE(NODE1,U,6)
- SET FPF=$PIECE(NODE1,U,9)
- SET ENC=$PIECE(NODE1,U,4)
- SET DFL=$PIECE(NODE1,U,11)
- SET DLDIV=$PIECE(NODE1,U,7)
- +11 ;filter out divisions if not all selected
- +12 if $GET(@SCRNARR@("DIVISION"))'=1&'$DATA(@SCRNARR@("DIVISION",+$GET(DIV)))
- QUIT
- +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 ;Update totals and store in ^tmp global, add count for each unique
- +17 ;feeder key/delivery location. Under each unique key create a record
- +18 ;for each unique combination of in/out code, observation status
- +19 ;save it in ^tmp global for later use.
- +20 IF REPORT="S"
- Begin DoDot:2
- +21 FOR I="DIV","DLT","STAT","OBS","PFK"
- IF @I=""
- SET @I="UNKNOWN"
- +22 ;Increment delivery location type (dlt) counter
- +23 ;S ^TMP($J,"ECXDLT",DIV,DLT,STAT,OBS)=$G(^TMP($J,"ECXDLT",DIV,DLT,STAT,OBS))+1
- +24 SET ^TMP($JOB,DIV,"ECXDLT",DLT,STAT,OBS)=$GET(^TMP($JOB,DIV,"ECXDLT",DLT,STAT,OBS))+1
- +25 ;Increment feeder key (fk) counter
- +26 ;S ^TMP($J,"ECXFKEY",DIV,PFK,STAT,OBS)=$G(^TMP($J,"ECXFKEY",DIV,PFK,STAT,OBS))+1
- +27 SET ^TMP($JOB,DIV,"ECXFKEY",PFK,STAT,OBS)=$GET(^TMP($JOB,DIV,"ECXFKEY",PFK,STAT,OBS))+1
- End DoDot:2
- +28 IF REPORT="D"
- Begin DoDot:2
- +29 FOR I="FPD","FPF","PFK","OBS","ENC"
- IF $GET(@I)=""
- SET @I="UNKNOWN"
- +30 FOR I="DIV","DLDIV","DFL","DLT"
- IF $GET(@I)=""
- SET @I="UNK"
- +31 ;Check patient status and screen if necessary
- +32 if STATUS'="B"&(STATUS'=STAT)
- QUIT
- +33 ;Increment fpd, fpf, pfk, obs counter
- +34 SET ^TMP($JOB,DIV,FPD,FPF,PFK,OBS)=$GET(^TMP($JOB,DIV,FPD,FPF,PFK,OBS))+1
- +35 ;Increment div, dfl, dlt counter
- +36 SET ^TMP($JOB,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT)=$GET(^TMP($JOB,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT))+1
- End DoDot:2
- End DoDot:1
- if FLAG
- QUIT
- +37 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +38 DO PRINT
- +39 DO AUDIT^ECXKILL
- +40 QUIT
- +41 ;
- PRINT ;print report
- +1 NEW FLAG,PG,LN,KEY,DLT,STAT,OBS,TOTAL,TCNT,CNT,PDLT
- +2 USE IO
- +3 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +4 SET (FLAG,PG)=0
- SET $PIECE(LN,"-",80)=""
- +5 IF '$DATA(^TMP($JOB))
- Begin DoDot:1
- +6 SET DIV=0
- FOR
- SET DIV=$ORDER(@SCRNARR@("DIVISION",DIV))
- if 'DIV
- QUIT
- Begin DoDot:2
- +7 DO HEADER
- +8 WRITE !
- +9 WRITE !,"**************************************************"
- +10 WRITE !,"* No data available for this patient division. *"
- +11 WRITE !,"**************************************************"
- End DoDot:2
- End DoDot:1
- QUIT
- +12 IF REPORT="S"
- Begin DoDot:1
- +13 SET DIV=""
- FOR
- SET DIV=$ORDER(^TMP($JOB,DIV))
- if DIV']""
- QUIT
- Begin DoDot:2
- +14 DO HEADER
- if FLAG
- QUIT
- +15 SET KEY=""
- FOR
- SET KEY=$ORDER(^TMP($JOB,DIV,KEY))
- if KEY']""
- QUIT
- Begin DoDot:3
- +16 SET PFK=""
- FOR
- SET PFK=$ORDER(^TMP($JOB,DIV,KEY,PFK))
- if PFK']""
- QUIT
- Begin DoDot:4
- +17 DO SUB
- if FLAG
- QUIT
- +18 SET STAT=""
- FOR
- SET STAT=$ORDER(^TMP($JOB,DIV,KEY,PFK,STAT))
- if STAT']""
- QUIT
- Begin DoDot:5
- +19 SET OBS=""
- FOR
- SET OBS=$ORDER(^TMP($JOB,DIV,KEY,PFK,STAT,OBS))
- if OBS']""
- QUIT
- Begin DoDot:6
- +20 SET TOTAL=$PIECE(^TMP($JOB,DIV,KEY,PFK,STAT,OBS),U)
- +21 ;Print by delivery location type (feeder key)
- +22 if ($Y+3>IOSL)
- DO HEADER
- DO SUB
- if FLAG
- QUIT
- +23 WRITE !,?1,STAT,?12,$SELECT(OBS="NO":" NO",1:"YES"),?30,TOTAL
- End DoDot:6
- if FLAG
- QUIT
- End DoDot:5
- if FLAG
- QUIT
- End DoDot:4
- if FLAG
- QUIT
- End DoDot:3
- if FLAG
- QUIT
- End DoDot:2
- if FLAG
- QUIT
- End DoDot:1
- +24 ;detail report print
- +25 IF REPORT="D"
- Begin DoDot:1
- +26 SET DIV=""
- FOR
- SET DIV=$ORDER(^TMP($JOB,DIV))
- if DIV']""
- QUIT
- Begin DoDot:2
- +27 SET FPD=""
- FOR
- SET FPD=$ORDER(^TMP($JOB,DIV,FPD))
- if FPD']""
- QUIT
- Begin DoDot:3
- +28 SET FPF=""
- FOR
- SET FPF=$ORDER(^TMP($JOB,DIV,FPD,FPF))
- if FPF']""
- QUIT
- Begin DoDot:4
- +29 SET PFK=""
- FOR
- SET PFK=$ORDER(^TMP($JOB,DIV,FPD,FPF,PFK))
- if PFK']""
- QUIT
- Begin DoDot:5
- +30 SET OBS=""
- FOR
- SET OBS=$ORDER(^TMP($JOB,DIV,FPD,FPF,PFK,OBS))
- if OBS']""
- QUIT
- Begin DoDot:6
- +31 SET TCNT=$GET(^TMP($JOB,DIV,FPD,FPF,PFK,OBS))
- +32 DO HEADER
- +33 SET ENC=""
- FOR
- SET ENC=$ORDER(^TMP($JOB,DIV,FPD,FPF,PFK,OBS,ENC))
- if ENC']""
- QUIT
- Begin DoDot:7
- +34 SET DLDIV=""
- FOR
- SET DLDIV=$ORDER(^TMP($JOB,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV))
- if DLDIV']""
- QUIT
- Begin DoDot:8
- +35 SET DFL=""
- FOR
- SET DFL=$ORDER(^TMP($JOB,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL))
- if DFL']""
- QUIT
- Begin DoDot:9
- +36 SET DLT=""
- FOR
- SET DLT=$ORDER(^TMP($JOB,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT))
- if DLT']""
- QUIT
- Begin DoDot:10
- +37 SET CNT=$GET(^TMP($JOB,DIV,FPD,FPF,PFK,OBS,ENC,DLDIV,DFL,DLT))
- +38 SET PDLT=DLT
- +39 IF ENC["I"
- IF DLT="UNK"
- SET PDLT=$SELECT(PFK["ST ORDER":"N/A",PFK["SUPP FEED":"N/A",PFK["TF":"N/A",1:DLT)
- +40 WRITE !,?1,$EXTRACT(ENC,1,25),?28,DLDIV,?42,DFL,?60,PDLT,?71,CNT
- +41 if ($Y+3>IOSL)
- DO HEADER
- if FLAG
- QUIT
- End DoDot:10
- if FLAG
- QUIT
- End DoDot:9
- if FLAG
- QUIT
- End DoDot:8
- if FLAG
- QUIT
- End DoDot:7
- if FLAG
- QUIT
- End DoDot:6
- if FLAG
- QUIT
- End DoDot:5
- if FLAG
- QUIT
- End DoDot:4
- if FLAG
- QUIT
- End DoDot:3
- if FLAG
- QUIT
- End DoDot:2
- if FLAG
- QUIT
- End DoDot:1
- +42 QUIT
- +43 ;
- +1 NEW JJ,SS,DIR,DIRUT,DTOUT,DUOUT,DSSID
- +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 FLAG=1
- End DoDot:1
- +5 if FLAG
- QUIT
- +6 SET DSSID=$SELECT($GET(DIV):$$NNT^XUAF4(DIV),1:"UNKNOWN^^")
- +7 if $Y!($EXTRACT(IOST)="C")
- WRITE @IOF
- SET PG=PG+1
- +8 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"_$SELECT(REPORT="S":" (Summary)",1:" (Detail)")
- +9 WRITE !,"DSS Extract Log #: "_ECXEXT
- +10 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +11 WRITE !,"Report Run Date/Time: "_ECXRUN
- +12 WRITE !,"Patient Division: "_$PIECE(DSSID,U)_$SELECT($PIECE(DSSID,U,2)'="":" ("_$PIECE(DSSID,U,2)_")",1:""),?68,$SELECT(REPORT="S":"Page: "_PG,1:"")
- +13 ;Detailed report sub-header
- +14 if '$DATA(^TMP($JOB))
- QUIT
- +15 IF REPORT="D"
- Begin DoDot:1
- +16 WRITE !,"Patient Status: "_$SELECT(STATUS="I":"Inpatient",STATUS="O":"Outpatient",1:"Inpatient and Outpatient"),?68,"Page: "_PG
- +17 WRITE !!,"Prod Div: "_FPD_" Prod Fac: "_FPF_" Prod FK: "_PFK_" OBS: "_OBS,?60," TOTAL: ",TCNT
- +18 WRITE !,?1,"Encounter Number",?28,"Del Div",?42,"Del Feed Loc",?60,"Loc Type",?71,"Count"
- End DoDot:1
- +19 QUIT
- SUB ;Summary report sub-header
- +1 IF REPORT="S"
- Begin DoDot:1
- +2 WRITE !!,"FEEDER KEY: "_PFK
- +3 WRITE !!,"I/O",?12,"OBS",?30,"TOTAL"
- End DoDot:1
- +4 QUIT
- +5 ;
- REPORT() ;Select report type
- +1 ;
- +2 ; Output - S = summary
- +3 ; D = detail
- +4 ;Init variables
- +5 NEW DIR,DIRUT,DUOUT,X,Y
- +6 SET DIR(0)="S^S:SUMMARY;D:DETAIL"
- +7 SET DIR("A")="Select type of report"
- +8 SET DIR("?",1)="S = Summary"
- +9 SET DIR("?",2)="D = Detail"
- +10 DO ^DIR
- +11 IF $DATA(DIRUT)!$DATA(DUOUT)
- SET FLAG=1
- QUIT ""
- +12 QUIT Y
- +13 ;
- STATUS() ;Select patient status for report
- +1 ;
- +2 ; Output - I = inpatient
- +3 ; O = outpatient
- +4 ; B = both
- +5 ;Init variables
- +6 NEW DIR,DIRUT,DUOUT,X,Y
- +7 SET DIR(0)="S^I:INPATIENT;O:OUTPATIENT;B:BOTH"
- +8 SET DIR("A")=" report?"
- +9 SET DIR("A")="Select patient status for report"
- +10 SET DIR("?",1)="I = Inpatient"
- +11 SET DIR("?",2)="O = Outpatient"
- +12 SET DIR("?",3)="B = Both"
- +13 DO ^DIR
- +14 IF $DATA(DIRUT)!$DATA(DUOUT)
- SET FLAG=1
- QUIT ""
- +15 QUIT Y