APCLASK ; IHS/CMI/LAB -GET PATIENT OR COHORT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;CMI/TUCSON/LAB - patch 3 - 10/26/1998 Y2K fixes
;The above line will be changed to be nonparameter as of the
;next version of this package. All callers should enter this
;routine at entry point START1^APCLASK(,,,)
G START2
;
START1(APCLDFN,APCLCUML) ;EP
;
START2 ;PEP PUBLISHED ENTRY POINT - called to create a report template
I 'APCLDFN W !,*7,"Report template entry not indicated!" H 2 Q
I '$D(^APCLRPT(APCLDFN)) W !,*7,"Indicated patient/cohort report template entry does not exist!" H 2 Q
I '$D(APCLCUML) S APCLCUML=0
I APCLCUML,'$D(^APCLRPT(APCLCUML)) W !,*7,"Indicated cumulative report entry does not exist!" H 2 Q
I '$D(DTIME) D ^XBKVAR
GETTIME S APCLSTP=0 D TIME G:APCLSTP X
START K ^TMP("APCLPTS",$J) F D ASK Q:APCLSTP
I '$D(^TMP("APCLPTS",$J))!(X["^") D CLEAN K APCLBDT,APCLEDT,APCLDATE,APCLFISC G GETTIME
S APCLSTP=0
K DIR S DIR(0)="S^1:Print Both Individual and Cumulative Reports;2:Print Individual Reports Only;3:Print Cumulative Report Only;4:Create EPI INFO file",DIR("A")="Enter Print option",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G START
S APCLPREP=Y
I APCLPREP=4 D FLAT Q:APCLSTP
D TASK I $D(IO("Q")) K IO("Q") D QUE G AGIN
I 'POP S APCLSTP=0 D ZTM
AGIN D CLEAN S APCLSTP=0 G START
X D EOJ
Q
;
TIME ;PEP - CALLED FROM BDM Get fiscal year or time frame
S Y=DT D DD^%DT S APCLTDTE=Y
S DIR(0)="SO^1:Fiscal Year;2:Date Range",DIR("A")="Indicate the desired time frame" D ^DIR K DIR
I '$D(DTOUT),'$D(DIRUT),'$D(DIROUT),Y W ! D @Y I 1
E S APCLSTP=1
Q
;
1 ; Fiscal Year
S DIR(0)="DA",DIR("A")="Enter report fiscal year: " D ^DIR K DIR
I '$D(DTOUT),'$D(DIRUT),'$D(DIROUT) S APCLFISC=$S($E(Y)=2:19,1:20)_$E(Y,2,3) D
. ;beginning Y2K CMI/TUCSON/LAB
. ;I APCLFISC=2000 S APCLBDT=2991001,APCLEDT=2000930 ;Y2000
. ;E S APCLBDT=$E(Y,1,3)-1_1001,APCLEDT=$E(Y,1,3)_"0930"
. S APCLBDT=$E(Y,1,3)-1_1001,APCLEDT=$E(Y,1,3)_"0930" ;Y2000
. ;end Y2K CMI/TUCSON/LAB
. S Y=APCLBDT D DD^%DT S APCLBDT=Y
. S (APCLED,Y)=APCLEDT D DD^%DT S APCLEDT=Y
. S APCLDATE=";DURING "_APCLBDT_"-"_APCLEDT
. S APCLFISC="Fiscal Year "_APCLFISC
E S APCLSTP=1
X2 Q
;
2 ; Date Range
ASKBD S %DT="AEX",%DT("A")="Enter beginning date: " D ^%DT G:X=U X3 S APCLBDT=Y I Y<0 G ASKBD
ASKED S %DT="AEX",%DT("A")="Enter ending date: " D ^%DT G:X=U X3 S APCLEDT=Y I Y<0,X]"" G ASKED
I APCLBDT>APCLEDT!(APCLEDT>DT) W !,"Beginning and ending dates must be prior to today, and beginning date",!,"must precede ending date.",! G ASKBD
X3 I $G(X)=U!'$D(APCLBDT)!'$D(APCLEDT) S APCLSTP=1
E D
. S Y=APCLBDT D DD^%DT S APCLBDT=Y
. S (APCLED,Y)=APCLEDT D DD^%DT S APCLEDT=Y
. S APCLDATE=";DURING "_APCLBDT_"-"_APCLEDT
Q
;
ASK ; Get patient name or cohort
;
K APCLPT
R:'$D(APCLPTS) !,"Enter patient or [search template name: ",X:DTIME
R:$D(APCLPTS) !,"Enter ANOTHER patient or [search template name: ",X:DTIME
;R !,"Enter patient or [search template name: ",X:DTIME
I "^"[X S APCLSTP=1 G X1
I $E(X)'="[" S APCLPT=""
E S X=$E(X,2,99)
I '$D(APCLPT) S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
S DIC=$S($D(APCLPT):"^DPT(",1:"^DIBT("),DIC(0)="EQM" D ^DIC K DIC
I Y=-1 G ASK
I $D(APCLPT) S ^TMP("APCLPTS",$J,+Y)="",APCLPTS=1
E F APCLPD=0:0 S APCLPD=$O(^DIBT(+Y,1,APCLPD)) Q:'APCLPD S ^TMP("APCLPTS",$J,APCLPD)=""
K APCLPT
X1 Q
;
ZTM ;PEP - CALLED FROM BDM - ENTRY POINT - for taskman
U IO
S (APCLSTP,APCLEPIN)=0
S APCLASK="" ; Lets ^APCLPRT know that it is called by this routine
K ^TMP("APCL",$J),^TMP("APCLCUML",$J),^TMP("APCLEPI",$J)
S APCLROOT="^TMP(""APCL"",$J)"
F APCLPD=0:0 S APCLPD=$O(^TMP("APCLPTS",$J,APCLPD)) Q:'APCLPD!APCLSTP D K ^TMP("APCL",$J)
.I $P(^APCLRPT(APCLDFN,0),U,3)]"" D @("^"_$P(^(0),U,3))
.I APCLPREP'=3,APCLPREP'=4 D EN^APCLPRT(APCLDFN,APCLROOT,APCLPD)
.I APCLPREP=4 D EPIREC
I APCLPREP'=2,APCLPREP'=4,APCLCUML,$D(^APCLRPT(APCLCUML)),$D(^TMP("APCLCUML",$J)),'APCLSTP D:$P(^APCLRPT(APCLCUML,0),U,3)]"" @("^"_$P(^(0),U,3)) S APCLROOT="^TMP(""APCLCUML"",$J)" D EN^APCLPRT(APCLCUML,APCLROOT)
I APCLPREP=4 D WRITEF^APCLDM
K ^TMP("APCLCUML",$J),^TMP("APCLPTS",$J),^TMP("APCLEPI",$J)
I $D(ZTQUEUED) S ZTREQ="@" D EOJ
I '$D(ZTQUEUED) D ^%ZISC
Q
;
TASK ; Task?
K IOP,%ZIS S %ZIS="PQM" D ^%ZIS I POP S IO=IO(0)
Q
;
QUE K ZTSAVE,ZTSK
NEW % F %="APCLSTP","APCLDMRG","APCLPREP","APCLPD","APCLPT","APCLBDT","APCLEDT","APCLDATE","APCLFISC","APCLTDTE","APCLDFN","APCLCUML","APCLFILE","APCLED","^TMP(""APCLPTS"",$J,","DUZ(" S ZTSAVE(%)=""
S ZTRTN="ZTM^APCLASK",ZTDESC=$P(^APCLRPT(APCLDFN,0),U)_" REPORT",ZTIO=ION,ZTDTH="" S:$D(IOCPU) ZTCPU=IOCPU
D ^%ZTLOAD
D HOME^%ZIS
K ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK,ZTCPU
I $D(IOF) W @IOF
E W !
Q
;
EPIREC ;create epi info record in ^TMP("APCLEPI",$J,n)
S X=$$REC^APCLDM(APCLPD,"DM AUDIT EPI INFO REC 1"),APCLEPIN=APCLEPIN+1,^TMP("APCLEPI",$J,APCLEPIN)=X
S X=$$REC^APCLDM(APCLPD,"DM AUDIT EPI INFO REC 2"),APCLEPIN=APCLEPIN+1,^TMP("APCLEPI",$J,APCLEPIN)=X
S X=$$REC^APCLDM(APCLPD,"DM AUDIT EPI INFO REC 3"),APCLEPIN=APCLEPIN+1,^TMP("APCLEPI",$J,APCLEPIN)=X
Q
FLAT ;
S APCLFILE=""
S DIR(0)="F^3:8",DIR("A")="Enter the name of the FILE to be Created (3-8 characters)" K DA D ^DIR K DIR
I $D(DIRUT) S APCLSTP=1 Q
I X'?1.8AN W !!,"Invalid format, must be letters and numbers",! G FLAT
S APCLFILE=$$LOW^XLFSTR(Y)_".rec"
W !!,"I am going to create a file called ",APCLFILE," which will reside in ",!,"the ",$S($P(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")," directory.",!
W "Actually, the file will be placed in the same directory that the data export"
W !,"globals are placed. See your site manager for assistance in finding the file",!,"after it is created. PLEASE jot down and remember the following file name:",!?15,"********** ",APCLFILE," **********",!
W "It may be several hours (or overnight) before your report and flat file are ",!,"finished.",!
W !,"The records that are generated and placed in file ",APCLFILE
W !,"are in a format readable by EPI INFO. For a definition of the format",!,"please see your user manual.",!
S DIR(0)="Y",DIR("A")="Is everything ok? Do you want to continue?",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT) S APCLSTP=1 Q
I 'Y S APCLSTP=1 Q
Q
CLEAN ;
K APCLPD,APCLPT,^TMP("APCLPTS",$J),APCLPREP,APCLPTS,APCLEPIN
Q
;
EOJ ;
I IO'=IO(0) D ^%ZISC
K APCLFISC,APCLPD,APCLPT,APCLDATE,APCLSTP,APCLDTE,APCLEDT,APCLBDT,APCLTDTE,APCLDFN,APCLROOT,^TMP("APCLPTS",$J),APCLASK,AUPNSEX,AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOD,AUPNDOB,APCLPREP,APCLEPIN,APCLED,APCLMAM,APCLED,APCLBD,APCLUED,ZTCPU
K APCLHTKI,APCLRXC1
Q
;
APCLASK ; IHS/CMI/LAB -GET PATIENT OR COHORT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;CMI/TUCSON/LAB - patch 3 - 10/26/1998 Y2K fixes
+3 ;The above line will be changed to be nonparameter as of the
+4 ;next version of this package. All callers should enter this
+5 ;routine at entry point START1^APCLASK(,,,)
+6 GOTO START2
+7 ;
START1(APCLDFN,APCLCUML) ;EP
+1 ;
START2 ;PEP PUBLISHED ENTRY POINT - called to create a report template
+1 IF 'APCLDFN
WRITE !,*7,"Report template entry not indicated!"
HANG 2
QUIT
+2 IF '$DATA(^APCLRPT(APCLDFN))
WRITE !,*7,"Indicated patient/cohort report template entry does not exist!"
HANG 2
QUIT
+3 IF '$DATA(APCLCUML)
SET APCLCUML=0
+4 IF APCLCUML
IF '$DATA(^APCLRPT(APCLCUML))
WRITE !,*7,"Indicated cumulative report entry does not exist!"
HANG 2
QUIT
+5 IF '$DATA(DTIME)
DO ^XBKVAR
GETTIME SET APCLSTP=0
DO TIME
IF APCLSTP
GOTO X
START KILL ^TMP("APCLPTS",$JOB)
FOR
DO ASK
IF APCLSTP
QUIT
+1 IF '$DATA(^TMP("APCLPTS",$JOB))!(X["^")
DO CLEAN
KILL APCLBDT,APCLEDT,APCLDATE,APCLFISC
GOTO GETTIME
+2 SET APCLSTP=0
+3 KILL DIR
SET DIR(0)="S^1:Print Both Individual and Cumulative Reports;2:Print Individual Reports Only;3:Print Cumulative Report Only;4:Create EPI INFO file"
SET DIR("A")="Enter Print option"
SET DIR("B")="1"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO START
+5 SET APCLPREP=Y
+6 IF APCLPREP=4
DO FLAT
IF APCLSTP
QUIT
+7 DO TASK
IF $DATA(IO("Q"))
KILL IO("Q")
DO QUE
GOTO AGIN
+8 IF 'POP
SET APCLSTP=0
DO ZTM
AGIN DO CLEAN
SET APCLSTP=0
GOTO START
X DO EOJ
+1 QUIT
+2 ;
TIME ;PEP - CALLED FROM BDM Get fiscal year or time frame
+1 SET Y=DT
DO DD^%DT
SET APCLTDTE=Y
+2 SET DIR(0)="SO^1:Fiscal Year;2:Date Range"
SET DIR("A")="Indicate the desired time frame"
DO ^DIR
KILL DIR
+3 IF '$DATA(DTOUT)
IF '$DATA(DIRUT)
IF '$DATA(DIROUT)
IF Y
WRITE !
DO @Y
IF 1
+4 IF '$TEST
SET APCLSTP=1
+5 QUIT
+6 ;
1 ; Fiscal Year
+1 SET DIR(0)="DA"
SET DIR("A")="Enter report fiscal year: "
DO ^DIR
KILL DIR
+2 IF '$DATA(DTOUT)
IF '$DATA(DIRUT)
IF '$DATA(DIROUT)
SET APCLFISC=$SELECT($EXTRACT(Y)=2:19,1:20)_$EXTRACT(Y,2,3)
Begin DoDot:1
+3 ;beginning Y2K CMI/TUCSON/LAB
+4 ;I APCLFISC=2000 S APCLBDT=2991001,APCLEDT=2000930 ;Y2000
+5 ;E S APCLBDT=$E(Y,1,3)-1_1001,APCLEDT=$E(Y,1,3)_"0930"
+6 ;Y2000
SET APCLBDT=$EXTRACT(Y,1,3)-1_1001
SET APCLEDT=$EXTRACT(Y,1,3)_"0930"
+7 ;end Y2K CMI/TUCSON/LAB
+8 SET Y=APCLBDT
DO DD^%DT
SET APCLBDT=Y
+9 SET (APCLED,Y)=APCLEDT
DO DD^%DT
SET APCLEDT=Y
+10 SET APCLDATE=";DURING "_APCLBDT_"-"_APCLEDT
+11 SET APCLFISC="Fiscal Year "_APCLFISC
End DoDot:1
+12 IF '$TEST
SET APCLSTP=1
X2 QUIT
+1 ;
2 ; Date Range
ASKBD SET %DT="AEX"
SET %DT("A")="Enter beginning date: "
DO ^%DT
IF X=U
GOTO X3
SET APCLBDT=Y
IF Y<0
GOTO ASKBD
ASKED SET %DT="AEX"
SET %DT("A")="Enter ending date: "
DO ^%DT
IF X=U
GOTO X3
SET APCLEDT=Y
IF Y<0
IF X]""
GOTO ASKED
+1 IF APCLBDT>APCLEDT!(APCLEDT>DT)
WRITE !,"Beginning and ending dates must be prior to today, and beginning date",!,"must precede ending date.",!
GOTO ASKBD
X3 IF $GET(X)=U!'$DATA(APCLBDT)!'$DATA(APCLEDT)
SET APCLSTP=1
+1 IF '$TEST
Begin DoDot:1
+2 SET Y=APCLBDT
DO DD^%DT
SET APCLBDT=Y
+3 SET (APCLED,Y)=APCLEDT
DO DD^%DT
SET APCLEDT=Y
+4 SET APCLDATE=";DURING "_APCLBDT_"-"_APCLEDT
End DoDot:1
+5 QUIT
+6 ;
ASK ; Get patient name or cohort
+1 ;
+2 KILL APCLPT
+3 IF '$DATA(APCLPTS)
READ !,"Enter patient or [search template name: ",X:DTIME
+4 IF $DATA(APCLPTS)
READ !,"Enter ANOTHER patient or [search template name: ",X:DTIME
+5 ;R !,"Enter patient or [search template name: ",X:DTIME
+6 IF "^"[X
SET APCLSTP=1
GOTO X1
+7 IF $EXTRACT(X)'="["
SET APCLPT=""
+8 IF '$TEST
SET X=$EXTRACT(X,2,99)
+9 IF '$DATA(APCLPT)
SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
+10 SET DIC=$SELECT($DATA(APCLPT):"^DPT(",1:"^DIBT(")
SET DIC(0)="EQM"
DO ^DIC
KILL DIC
+11 IF Y=-1
GOTO ASK
+12 IF $DATA(APCLPT)
SET ^TMP("APCLPTS",$JOB,+Y)=""
SET APCLPTS=1
+13 IF '$TEST
FOR APCLPD=0:0
SET APCLPD=$ORDER(^DIBT(+Y,1,APCLPD))
IF 'APCLPD
QUIT
SET ^TMP("APCLPTS",$JOB,APCLPD)=""
+14 KILL APCLPT
X1 QUIT
+1 ;
ZTM ;PEP - CALLED FROM BDM - ENTRY POINT - for taskman
+1 USE IO
+2 SET (APCLSTP,APCLEPIN)=0
+3 ; Lets ^APCLPRT know that it is called by this routine
SET APCLASK=""
+4 KILL ^TMP("APCL",$JOB),^TMP("APCLCUML",$JOB),^TMP("APCLEPI",$JOB)
+5 SET APCLROOT="^TMP(""APCL"",$J)"
+6 FOR APCLPD=0:0
SET APCLPD=$ORDER(^TMP("APCLPTS",$JOB,APCLPD))
IF 'APCLPD!APCLSTP
QUIT
Begin DoDot:1
+7 IF $PIECE(^APCLRPT(APCLDFN,0),U,3)]""
DO @("^"_$PIECE(^(0),U,3))
+8 IF APCLPREP'=3
IF APCLPREP'=4
DO EN^APCLPRT(APCLDFN,APCLROOT,APCLPD)
+9 IF APCLPREP=4
DO EPIREC
End DoDot:1
KILL ^TMP("APCL",$JOB)
+10 IF APCLPREP'=2
IF APCLPREP'=4
IF APCLCUML
IF $DATA(^APCLRPT(APCLCUML))
IF $DATA(^TMP("APCLCUML",$JOB))
IF 'APCLSTP
IF $PIECE(^APCLRPT(APCLCUML,0),U,3)]""
DO @("^"_$PIECE(^(0),U,3))
SET APCLROOT="^TMP(""APCLCUML"",$J)"
DO EN^APCLPRT(APCLCUML,APCLROOT)
+11 IF APCLPREP=4
DO WRITEF^APCLDM
+12 KILL ^TMP("APCLCUML",$JOB),^TMP("APCLPTS",$JOB),^TMP("APCLEPI",$JOB)
+13 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO EOJ
+14 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+15 QUIT
+16 ;
TASK ; Task?
+1 KILL IOP,%ZIS
SET %ZIS="PQM"
DO ^%ZIS
IF POP
SET IO=IO(0)
+2 QUIT
+3 ;
QUE KILL ZTSAVE,ZTSK
+1 NEW %
FOR %="APCLSTP","APCLDMRG","APCLPREP","APCLPD","APCLPT","APCLBDT","APCLEDT","APCLDATE","APCLFISC","APCLTDTE","APCLDFN","APCLCUML","APCLFILE","APCLED","^TMP(""APCLPTS"",$J,","DUZ("
SET ZTSAVE(%)=""
+2 SET ZTRTN="ZTM^APCLASK"
SET ZTDESC=$PIECE(^APCLRPT(APCLDFN,0),U)_" REPORT"
SET ZTIO=ION
SET ZTDTH=""
IF $DATA(IOCPU)
SET ZTCPU=IOCPU
+3 DO ^%ZTLOAD
+4 DO HOME^%ZIS
+5 KILL ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK,ZTCPU
+6 IF $DATA(IOF)
WRITE @IOF
+7 IF '$TEST
WRITE !
+8 QUIT
+9 ;
EPIREC ;create epi info record in ^TMP("APCLEPI",$J,n)
+1 SET X=$$REC^APCLDM(APCLPD,"DM AUDIT EPI INFO REC 1")
SET APCLEPIN=APCLEPIN+1
SET ^TMP("APCLEPI",$JOB,APCLEPIN)=X
+2 SET X=$$REC^APCLDM(APCLPD,"DM AUDIT EPI INFO REC 2")
SET APCLEPIN=APCLEPIN+1
SET ^TMP("APCLEPI",$JOB,APCLEPIN)=X
+3 SET X=$$REC^APCLDM(APCLPD,"DM AUDIT EPI INFO REC 3")
SET APCLEPIN=APCLEPIN+1
SET ^TMP("APCLEPI",$JOB,APCLEPIN)=X
+4 QUIT
FLAT ;
+1 SET APCLFILE=""
+2 SET DIR(0)="F^3:8"
SET DIR("A")="Enter the name of the FILE to be Created (3-8 characters)"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET APCLSTP=1
QUIT
+4 IF X'?1.8AN
WRITE !!,"Invalid format, must be letters and numbers",!
GOTO FLAT
+5 SET APCLFILE=$$LOW^XLFSTR(Y)_".rec"
+6 WRITE !!,"I am going to create a file called ",APCLFILE," which will reside in ",!,"the ",$SELECT($PIECE(^AUTTSITE(1,0),U,21)=1:"/usr/spool/uucppublic",1:"C:\EXPORT")," directory.",!
+7 WRITE "Actually, the file will be placed in the same directory that the data export"
+8 WRITE !,"globals are placed. See your site manager for assistance in finding the file",!,"after it is created. PLEASE jot down and remember the following file name:",!?15,"********** ",APCLFILE," **********",!
+9 WRITE "It may be several hours (or overnight) before your report and flat file are ",!,"finished.",!
+10 WRITE !,"The records that are generated and placed in file ",APCLFILE
+11 WRITE !,"are in a format readable by EPI INFO. For a definition of the format",!,"please see your user manual.",!
+12 SET DIR(0)="Y"
SET DIR("A")="Is everything ok? Do you want to continue?"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
SET APCLSTP=1
QUIT
+14 IF 'Y
SET APCLSTP=1
QUIT
+15 QUIT
CLEAN ;
+1 KILL APCLPD,APCLPT,^TMP("APCLPTS",$JOB),APCLPREP,APCLPTS,APCLEPIN
+2 QUIT
+3 ;
EOJ ;
+1 IF IO'=IO(0)
DO ^%ZISC
+2 KILL APCLFISC,APCLPD,APCLPT,APCLDATE,APCLSTP,APCLDTE,APCLEDT,APCLBDT,APCLTDTE,APCLDFN,APCLROOT,^TMP("APCLPTS",$JOB),APCLASK,AUPNSEX,AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOD,AUPNDOB,APCLPREP,APCLEPIN,APCLED,APCLMAM,APCLED,APCLBD,APCLUED,ZTCPU
+3 KILL APCLHTKI,APCLRXC1
+4 QUIT
+5 ;
