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

ECXAMTL.m

Go to the documentation of this file. 
  1. ECXAMTL ;ALB/JAM - MTL Extract Audit Report; May 24, 1999 ;10/22/13  17:31
  1.  ;;3.0;DSS EXTRACTS;**24,44,148**;Dec 22, 1997;Build 3
  1. EN ;entry point for MTL extract audit report
  1.  N %X,%Y
  1.  ;ecxaud=0 for 'extract' audit
  1.  S ECXERR=0
  1.  S ECXHEAD="MTL",ECXAUD=0
  1.  W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
  1.  ;select extract
  1.  D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD) I ECXERR D  Q
  1.  . K ECXHEAD,ECXAUD,ECXERR
  1.  ;get facility/division
  1.  S ECXALL=1
  1.  D MTL^ECXDVSN2(.ECXDIV,ECXALL,.ECXERR) I ECXERR D AUDIT^ECXKILL Q
  1.  ;select output device and queue report if requested
  1.  S ECXPGM="PROCESS^ECXAMTL",ECXDESC="MTL Extract Audit Report"
  1.  S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")=""
  1.  S ECXSAVE("ECXARRAY(")="" W !
  1.  D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
  1.  I ECXSAVE("POP")=1 D  Q
  1.  . W !!,?5,"Try again later... exiting.",!
  1.  . D AUDIT^ECXKILL
  1.  I ECXSAVE("ZTSK")=0 D
  1.  . K ECXSAVE,ECXPGM,ECXDESC
  1.  . D PROCESS^ECXAMTL
  1.  I IO'=IO(0) D ^%ZISC
  1.  D HOME^%ZIS
  1.  D AUDIT^ECXKILL
  1.  Q
  1. PROCESS ;process data in file #727.812
  1.  N DAY,MTLDAT,MTLDAT1,SSN,NAME,EXN,IEN,ASI,SPC,TSTNAM,PROV,DATND,TSTSC
  1.  N NODE
  1.  K ^TMP($J,"ECXMTL") S EXN=ECXARRAY("EXTRACT")
  1.  ;set start and end date in interal format
  1.  S X=ECXARRAY("START") S %DT="" D ^%DT S ECXSTART=Y
  1.  S X=ECXARRAY("END") D ^%DT S ECXEND=Y
  1.  ;get run date in external format
  1.  D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
  1.  ;get records for specified date range within extract
  1.  S IEN=0 F  S IEN=$O(^ECX(727.812,"AC",EXN,IEN)) Q:'IEN  D
  1.  . S MTLDAT=^ECX(727.812,IEN,0),MTLDAT1=$G(^ECX(727.812,IEN,1))
  1.  . ;convert date to fileman internal format
  1.  . S DAY=$P(MTLDAT,U,9),$E(DAY,1,2)=$E(DAY,1,2)-17 Q:$L(DAY)<7
  1.  . I DAY<ECXSTART!(DAY>ECXEND) Q
  1.  . S SSN=$P(MTLDAT,U,6),NAME=$P(MTLDAT,U,7),TSTNAM=$P(MTLDAT,U,21)
  1.  . S PROV=$P(MTLDAT,U,18)
  1.  . S:PROV'="" PROV=$$GET1^DIQ(200,$E(PROV,2,999),.01,"I")
  1.  . S TSTSC=$P(MTLDAT,U,25),ASI=$P(MTLDAT1,U,5),SPC=$P(MTLDAT1,U,6)
  1.  . ;determine next level for ^TMP($J,"ECXMTL",
  1.  . Q:TSTNAM=""  S NODE=TSTNAM I TSTNAM'="ASI",TSTNAM'="GAF" S NODE="PI"
  1.  . ;data to be stored at node in ^TMP($J,"ECXMTL,NODE
  1.  . S DATND=$S(NODE="ASI":ASI_U_SPC,NODE="GAF":TSTSC_U_PROV,1:"")
  1.  . ;store data in ^TMP($J,"ECXMTL",NODE
  1.  . I NODE="PI" D  Q
  1.  . . I '$D(^TMP($J,"ECXMTL",NODE,TSTNAM,NAME,SSN,DAY)) D
  1.  . . . S ^TMP($J,"ECXMTL",NODE,TSTNAM,NAME,SSN,DAY)=DATND
  1.  . . . S ^TMP($J,"ECXMTL",NODE,TSTNAM)=$G(^TMP($J,"ECXMTL",NODE,TSTNAM))+1
  1.  . I '$D(^TMP($J,"ECXMTL",NODE,NAME,SSN,DAY)) D
  1.  . . S ^TMP($J,"ECXMTL",NODE,NAME,SSN,DAY)=DATND
  1.  D PRINT,AUDIT^ECXKILL
  1.  Q
  1. PRINT ;print the MTL audit report
  1.  N ND,NAM,SSN,DAY,PITOT,GAFTOT,ASI,INSTOT,CNT,DIV,QFL,LN,I,CLS,SPC,ASISP
  1.  N PG,ASITOT,ASISPTOT
  1.  U IO
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
  1.  S (ASITOT,ASISPTOT,QFL,PG,CNT)=0,$P(LN,"-",74)="",DIV=$O(ECXDIV(""))
  1.  ;
  1.  ;- Added new class, ASI-MV, per MH patch YS*5.01*67
  1.  F I=1:1:4,999 S (ASI(I),ASISP(I))=0 D
  1.  . S ASI(I,0)=$S(I=1:"Full",I=2:"Lite",I=3:"Follow-up",I=4:"For ASI-MV",1:"Unspecified")
  1.  . S ASISP(I,0)=$S(I=1:"Terminated",I=2:"Refused",I=3:"Unable",1:"Unspecified")
  1.  S ASISP(0)=0,ASISP(0,0)="Completed" D HEADER
  1.  S ND="" F  S ND=$O(^TMP($J,"ECXMTL",ND)) Q:ND=""  D  I QFL Q
  1.  . S CNT=CNT+1 D H1 S NAM="" I ($Y+3)>IOSL D HEADER I QFL Q
  1.  . I ND="PI" D  Q
  1.  . . F  S NAM=$O(^TMP($J,"ECXMTL",ND,NAM)) Q:NAM=""  D  I QFL Q
  1.  . . . S INSTOT=^TMP($J,"ECXMTL",ND,NAM)
  1.  . . . D:($Y+3)>IOSL HEADER Q:QFL  W ?5,NAM,?32,$J(INSTOT,8),!
  1.  . . . S PITOT=$G(PITOT)+INSTOT
  1.  . . I ($Y+3)>IOSL D HEADER I QFL Q
  1.  . . W ?5,LN,!,?5,"Total",?30,$J(PITOT,10),!
  1.  . F  S NAM=$O(^TMP($J,"ECXMTL",ND,NAM)) Q:NAM=""  S SSN="" D  I QFL Q
  1.  . .F  S SSN=$O(^TMP($J,"ECXMTL",ND,NAM,SSN)) Q:SSN=""  S DAY="" D  Q:QFL
  1.  . . . F  S DAY=$O(^TMP($J,"ECXMTL",ND,NAM,SSN,DAY)) Q:DAY=""  D P1 Q:QFL
  1.  . I QFL Q
  1.  . ;print GAF total
  1.  . I ND="GAF" D  Q
  1.  . . D:($Y+3)>IOSL HEADER Q:QFL  W ?5,LN,!,?5,"Total: ",GAFTOT,!
  1.  . ;print ASI totals
  1.  . I ND="ASI" D  Q
  1.  . . D:($Y+3)>IOSL HEADER Q:QFL  W ?5,LN,! S (CLS,SPC)=-1
  1.  . . F I=1:1:5 D  Q:(CLS="")&(SPC="")  I QFL Q
  1.  . . . I ($Y+3)>IOSL D HEADER I QFL Q
  1.  . . . I CLS'="" S CLS=$O(ASI(CLS)) D:CLS'=""
  1.  . . . . W ?29,$J(ASI(CLS),8)," ",ASI(CLS,0)
  1.  . . . . S ASITOT=ASITOT+ASI(CLS)
  1.  . . . I SPC'="" S SPC=$O(ASISP(SPC)) D:SPC'=""
  1.  . . . . W ?50,$J(ASISP(SPC),8)," ",ASISP(SPC,0) D
  1.  . . . . S ASISPTOT=ASISPTOT+ASISP(SPC)
  1.  . . . W !
  1.  . . Q:QFL  W ?5,LN,!,?27,$J(ASITOT,10),?48,$J(ASISPTOT,10)," ","Total"
  1.  Q
  1. P1 ;print ASI and GAF records
  1.  N DATND,DATE
  1.  S DATND=^TMP($J,"ECXMTL",ND,NAM,SSN,DAY)
  1.  S DATE=$E(DAY,4,5)_"/"_$E(DAY,6,7)_"/"_($E(DAY)+17)_$E(DAY,2,3)
  1.  D:($Y+3)>IOSL HEADER Q:QFL  W ?5,NAM,?14,$E(SSN,$L(SSN)-3,$L(SSN))
  1.  I ND="ASI" D  Q
  1.  . S CLS=$P(DATND,U),SPC=$P(DATND,U,2)
  1.  . W ?21,DATE,?36,$S(CLS=1:"Full",CLS=2:"Lite",CLS=3:"F-up",CLS=4:"ASI-MV",1:""),?57,SPC,!
  1.  . S:CLS="" CLS=999 S:SPC="" SPC=999 S:SPC="N" SPC=0
  1.  . S ASI(CLS)=$G(ASI(CLS))+1,ASISP(SPC)=$G(ASISP(SPC))+1
  1.  I ND="GAF" D  Q
  1.  . W ?21,DATE,?36,$P(DATND,U,2),!
  1.  . S GAFTOT=$G(GAFTOT)+1
  1.  Q
  1.  N JJ,SS
  1.  I $E(IOST)="C" D  I QFL Q
  1.  . S SS=22-$Y F JJ=1:1:SS W !
  1.  . I PG S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFL=1
  1.  W:PG!($E(IOST)="C") @IOF S PG=PG+1
  1.  W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
  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 $P(ECXDIV(DIV),U)="" D
  1.  . S $P(ECXDIV(DIV),U)=$P(ECXDIV(DIV),U,3)
  1.  . I $P(ECXDIV(DIV),U)="" S $P(ECXDIV(DIV),U)="Unknown"
  1.  W !,"Facility:             "_$P(ECXDIV(DIV),U)
  1.  W " ("_$P(ECXDIV(DIV),U,4)_")",?68,"Page: "_PG
  1. H1 I $G(ND)'="" D
  1.  . W !!,CNT,".",?5
  1.  . I ND="PI" W "Psych Instruments segment",!! Q
  1.  . W ND," segment",!!
  1.  . W ?5,"Name",?14,"SSN",?21
  1.  . I ND="ASI" W "Interview",?36,"Class",?54,"Special"
  1.  . I ND="GAF" W "Date",?36,"Clinician"
  1.  . W !,?5,LN,!
  1.  Q