BDMASK ; IHS/CMI/LAB -GET PATIENT OR COHORT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
;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^BDMASK(,,,)
G START2
;
START1(BDMDFN,BDMCUML) ;EP
;
START2 ;PEP PUBLISHED ENTRY POINT - called to create a report template
I 'BDMDFN W !,*7,"Report template entry not indicated!" H 2 Q
I '$D(^BDMRPT(BDMDFN)) W !,*7,"Indicated patient/cohort report template entry does not exist!" H 2 Q
I '$D(BDMCUML) S BDMCUML=0
I BDMCUML,'$D(^BDMRPT(BDMCUML)) W !,*7,"Indicated cumulative report entry does not exist!" H 2 Q
I '$D(DTIME) D ^XBKVAR
GETTIME S BDMSTP=0 D TIME G:BDMSTP X
START K ^TMP("BDMPTS",$J) F D ASK Q:BDMSTP
I '$D(^TMP("BDMPTS",$J))!(X["^") D CLEAN K BDMBDT,BDMEDT,BDMDATE,BDMFISC G GETTIME
S BDMSTP=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 BDMPREP=Y
I BDMPREP=4 D FLAT Q:BDMSTP
D TASK I $D(IO("Q")) K IO("Q") D QUE G AGIN
I 'POP S BDMSTP=0 D ZTM
AGIN D CLEAN S BDMSTP=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 BDMTDTE=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 BDMSTP=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 BDMFISC=$S($E(Y)=2:19,1:20)_$E(Y,2,3) D
. ;beginning Y2K CMI/TUCSON/LAB
. ;I BDMFISC=2000 S BDMBDT=2991001,BDMEDT=2000930 ;Y2000
. ;E S BDMBDT=$E(Y,1,3)-1_1001,BDMEDT=$E(Y,1,3)_"0930"
. S BDMBDT=$E(Y,1,3)-1_1001,BDMEDT=$E(Y,1,3)_"0930" ;Y2000
. ;end Y2K CMI/TUCSON/LAB
. S Y=BDMBDT D DD^%DT S BDMBDT=Y
. S (BDMED,Y)=BDMEDT D DD^%DT S BDMEDT=Y
. S BDMDATE=";DURING "_BDMBDT_"-"_BDMEDT
. S BDMFISC="Fiscal Year "_BDMFISC
E S BDMSTP=1
X2 Q
;
2 ; Date Range
ASKBD S %DT="AEX",%DT("A")="Enter beginning date: " D ^%DT G:X=U X3 S BDMBDT=Y I Y<0 G ASKBD
ASKED S %DT="AEX",%DT("A")="Enter ending date: " D ^%DT G:X=U X3 S BDMEDT=Y I Y<0,X]"" G ASKED
I BDMBDT>BDMEDT!(BDMEDT>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(BDMBDT)!'$D(BDMEDT) S BDMSTP=1
E D
. S Y=BDMBDT D DD^%DT S BDMBDT=Y
. S (BDMED,Y)=BDMEDT D DD^%DT S BDMEDT=Y
. S BDMDATE=";DURING "_BDMBDT_"-"_BDMEDT
Q
;
ASK ; Get patient name or cohort
;
K BDMPT
R:'$D(BDMPTS) !,"Enter patient or [search template name: ",X:DTIME
R:$D(BDMPTS) !,"Enter ANOTHER patient or [search template name: ",X:DTIME
;R !,"Enter patient or [search template name: ",X:DTIME
I "^"[X S BDMSTP=1 G X1
I $E(X)'="[" S BDMPT=""
E S X=$E(X,2,99)
I '$D(BDMPT) S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
S DIC=$S($D(BDMPT):"^DPT(",1:"^DIBT("),DIC(0)="EQM" D ^DIC K DIC
I Y=-1 G ASK
I $D(BDMPT) S ^TMP("BDMPTS",$J,+Y)="",BDMPTS=1
E F BDMPD=0:0 S BDMPD=$O(^DIBT(+Y,1,BDMPD)) Q:'BDMPD S ^TMP("BDMPTS",$J,BDMPD)=""
K BDMPT
X1 Q
;
ZTM ;PEP - CALLED FROM BDM - ENTRY POINT - for taskman
U IO
S (BDMSTP,BDMEPIN)=0
S BDMASK="" ; Lets ^BDMPRT know that it is called by this routine
K ^TMP("BDM",$J),^TMP("BDMCUML",$J),^TMP("BDMEPI",$J)
S BDMROOT="^TMP(""BDM"",$J)"
F BDMPD=0:0 S BDMPD=$O(^TMP("BDMPTS",$J,BDMPD)) Q:'BDMPD!BDMSTP D K ^TMP("BDM",$J)
.I $P(^BDMRPT(BDMDFN,0),U,3)]"" D @("^"_$P(^(0),U,3))
.I BDMPREP'=3,BDMPREP'=4 D EN^BDMPRT(BDMDFN,BDMROOT,BDMPD)
.I BDMPREP=4 D EPIREC
I BDMPREP'=2,BDMPREP'=4,BDMCUML,$D(^BDMRPT(BDMCUML)),$D(^TMP("BDMCUML",$J)),'BDMSTP D:$P(^BDMRPT(BDMCUML,0),U,3)]"" @("^"_$P(^(0),U,3)) S BDMROOT="^TMP(""BDMCUML"",$J)" D EN^BDMPRT(BDMCUML,BDMROOT)
I BDMPREP=4 D WRITEF^BDMDM
K ^TMP("BDMCUML",$J),^TMP("BDMPTS",$J),^TMP("BDMEPI",$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 %="BDMSTP","BDMDMRG","BDMPREP","BDMPD","BDMPT","BDMBDT","BDMEDT","BDMDATE","BDMFISC","BDMTDTE","BDMDFN","BDMCUML","BDMFILE","BDMED","^TMP(""BDMPTS"",$J,","DUZ(" S ZTSAVE(%)=""
S ZTRTN="ZTM^BDMASK",ZTDESC=$P(^BDMRPT(BDMDFN,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("BDMEPI",$J,n)
S X=$$REC^BDMDM(BDMPD,"DM AUDIT EPI INFO REC 1"),BDMEPIN=BDMEPIN+1,^TMP("BDMEPI",$J,BDMEPIN)=X
S X=$$REC^BDMDM(BDMPD,"DM AUDIT EPI INFO REC 2"),BDMEPIN=BDMEPIN+1,^TMP("BDMEPI",$J,BDMEPIN)=X
S X=$$REC^BDMDM(BDMPD,"DM AUDIT EPI INFO REC 3"),BDMEPIN=BDMEPIN+1,^TMP("BDMEPI",$J,BDMEPIN)=X
Q
FLAT ;
S BDMFILE=""
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 BDMSTP=1 Q
I X'?1.8AN W !!,"Invalid format, must be letters and numbers",! G FLAT
S BDMFILE=$$LOW^XLFSTR(Y)_".rec"
W !!,"I am going to create a file called ",BDMFILE," 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,"********** ",BDMFILE," **********",!
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 ",BDMFILE
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 BDMSTP=1 Q
I 'Y S BDMSTP=1 Q
Q
CLEAN ;
K BDMPD,BDMPT,^TMP("BDMPTS",$J),BDMPREP,BDMPTS,BDMEPIN
Q
;
EOJ ;
I IO'=IO(0) D ^%ZISC
K BDMFISC,BDMPD,BDMPT,BDMDATE,BDMSTP,BDMDTE,BDMEDT,BDMBDT,BDMTDTE,BDMDFN,BDMROOT,^TMP("BDMPTS",$J),BDMASK,AUPNSEX,AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOD,AUPNDOB,BDMPREP,BDMEPIN,BDMED,BDMMAM,BDMED,BDMBD,BDMUED,ZTCPU
K BDMHTKI,BDMRXC1
Q
;
BDMASK ; IHS/CMI/LAB -GET PATIENT OR COHORT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
+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^BDMASK(,,,)
+6 GOTO START2
+7 ;
START1(BDMDFN,BDMCUML) ;EP
+1 ;
START2 ;PEP PUBLISHED ENTRY POINT - called to create a report template
+1 IF 'BDMDFN
WRITE !,*7,"Report template entry not indicated!"
HANG 2
QUIT
+2 IF '$DATA(^BDMRPT(BDMDFN))
WRITE !,*7,"Indicated patient/cohort report template entry does not exist!"
HANG 2
QUIT
+3 IF '$DATA(BDMCUML)
SET BDMCUML=0
+4 IF BDMCUML
IF '$DATA(^BDMRPT(BDMCUML))
WRITE !,*7,"Indicated cumulative report entry does not exist!"
HANG 2
QUIT
+5 IF '$DATA(DTIME)
DO ^XBKVAR
GETTIME SET BDMSTP=0
DO TIME
IF BDMSTP
GOTO X
START KILL ^TMP("BDMPTS",$JOB)
FOR
DO ASK
IF BDMSTP
QUIT
+1 IF '$DATA(^TMP("BDMPTS",$JOB))!(X["^")
DO CLEAN
KILL BDMBDT,BDMEDT,BDMDATE,BDMFISC
GOTO GETTIME
+2 SET BDMSTP=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 BDMPREP=Y
+6 IF BDMPREP=4
DO FLAT
IF BDMSTP
QUIT
+7 DO TASK
IF $DATA(IO("Q"))
KILL IO("Q")
DO QUE
GOTO AGIN
+8 IF 'POP
SET BDMSTP=0
DO ZTM
AGIN DO CLEAN
SET BDMSTP=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 BDMTDTE=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 BDMSTP=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 BDMFISC=$SELECT($EXTRACT(Y)=2:19,1:20)_$EXTRACT(Y,2,3)
Begin DoDot:1
+3 ;beginning Y2K CMI/TUCSON/LAB
+4 ;I BDMFISC=2000 S BDMBDT=2991001,BDMEDT=2000930 ;Y2000
+5 ;E S BDMBDT=$E(Y,1,3)-1_1001,BDMEDT=$E(Y,1,3)_"0930"
+6 ;Y2000
SET BDMBDT=$EXTRACT(Y,1,3)-1_1001
SET BDMEDT=$EXTRACT(Y,1,3)_"0930"
+7 ;end Y2K CMI/TUCSON/LAB
+8 SET Y=BDMBDT
DO DD^%DT
SET BDMBDT=Y
+9 SET (BDMED,Y)=BDMEDT
DO DD^%DT
SET BDMEDT=Y
+10 SET BDMDATE=";DURING "_BDMBDT_"-"_BDMEDT
+11 SET BDMFISC="Fiscal Year "_BDMFISC
End DoDot:1
+12 IF '$TEST
SET BDMSTP=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 BDMBDT=Y
IF Y<0
GOTO ASKBD
ASKED SET %DT="AEX"
SET %DT("A")="Enter ending date: "
DO ^%DT
IF X=U
GOTO X3
SET BDMEDT=Y
IF Y<0
IF X]""
GOTO ASKED
+1 IF BDMBDT>BDMEDT!(BDMEDT>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(BDMBDT)!'$DATA(BDMEDT)
SET BDMSTP=1
+1 IF '$TEST
Begin DoDot:1
+2 SET Y=BDMBDT
DO DD^%DT
SET BDMBDT=Y
+3 SET (BDMED,Y)=BDMEDT
DO DD^%DT
SET BDMEDT=Y
+4 SET BDMDATE=";DURING "_BDMBDT_"-"_BDMEDT
End DoDot:1
+5 QUIT
+6 ;
ASK ; Get patient name or cohort
+1 ;
+2 KILL BDMPT
+3 IF '$DATA(BDMPTS)
READ !,"Enter patient or [search template name: ",X:DTIME
+4 IF $DATA(BDMPTS)
READ !,"Enter ANOTHER patient or [search template name: ",X:DTIME
+5 ;R !,"Enter patient or [search template name: ",X:DTIME
+6 IF "^"[X
SET BDMSTP=1
GOTO X1
+7 IF $EXTRACT(X)'="["
SET BDMPT=""
+8 IF '$TEST
SET X=$EXTRACT(X,2,99)
+9 IF '$DATA(BDMPT)
SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
+10 SET DIC=$SELECT($DATA(BDMPT):"^DPT(",1:"^DIBT(")
SET DIC(0)="EQM"
DO ^DIC
KILL DIC
+11 IF Y=-1
GOTO ASK
+12 IF $DATA(BDMPT)
SET ^TMP("BDMPTS",$JOB,+Y)=""
SET BDMPTS=1
+13 IF '$TEST
FOR BDMPD=0:0
SET BDMPD=$ORDER(^DIBT(+Y,1,BDMPD))
IF 'BDMPD
QUIT
SET ^TMP("BDMPTS",$JOB,BDMPD)=""
+14 KILL BDMPT
X1 QUIT
+1 ;
ZTM ;PEP - CALLED FROM BDM - ENTRY POINT - for taskman
+1 USE IO
+2 SET (BDMSTP,BDMEPIN)=0
+3 ; Lets ^BDMPRT know that it is called by this routine
SET BDMASK=""
+4 KILL ^TMP("BDM",$JOB),^TMP("BDMCUML",$JOB),^TMP("BDMEPI",$JOB)
+5 SET BDMROOT="^TMP(""BDM"",$J)"
+6 FOR BDMPD=0:0
SET BDMPD=$ORDER(^TMP("BDMPTS",$JOB,BDMPD))
IF 'BDMPD!BDMSTP
QUIT
Begin DoDot:1
+7 IF $PIECE(^BDMRPT(BDMDFN,0),U,3)]""
DO @("^"_$PIECE(^(0),U,3))
+8 IF BDMPREP'=3
IF BDMPREP'=4
DO EN^BDMPRT(BDMDFN,BDMROOT,BDMPD)
+9 IF BDMPREP=4
DO EPIREC
End DoDot:1
KILL ^TMP("BDM",$JOB)
+10 IF BDMPREP'=2
IF BDMPREP'=4
IF BDMCUML
IF $DATA(^BDMRPT(BDMCUML))
IF $DATA(^TMP("BDMCUML",$JOB))
IF 'BDMSTP
IF $PIECE(^BDMRPT(BDMCUML,0),U,3)]""
DO @("^"_$PIECE(^(0),U,3))
SET BDMROOT="^TMP(""BDMCUML"",$J)"
DO EN^BDMPRT(BDMCUML,BDMROOT)
+11 IF BDMPREP=4
DO WRITEF^BDMDM
+12 KILL ^TMP("BDMCUML",$JOB),^TMP("BDMPTS",$JOB),^TMP("BDMEPI",$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 %="BDMSTP","BDMDMRG","BDMPREP","BDMPD","BDMPT","BDMBDT","BDMEDT","BDMDATE","BDMFISC","BDMTDTE","BDMDFN","BDMCUML","BDMFILE","BDMED","^TMP(""BDMPTS"",$J,","DUZ("
SET ZTSAVE(%)=""
+2 SET ZTRTN="ZTM^BDMASK"
SET ZTDESC=$PIECE(^BDMRPT(BDMDFN,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("BDMEPI",$J,n)
+1 SET X=$$REC^BDMDM(BDMPD,"DM AUDIT EPI INFO REC 1")
SET BDMEPIN=BDMEPIN+1
SET ^TMP("BDMEPI",$JOB,BDMEPIN)=X
+2 SET X=$$REC^BDMDM(BDMPD,"DM AUDIT EPI INFO REC 2")
SET BDMEPIN=BDMEPIN+1
SET ^TMP("BDMEPI",$JOB,BDMEPIN)=X
+3 SET X=$$REC^BDMDM(BDMPD,"DM AUDIT EPI INFO REC 3")
SET BDMEPIN=BDMEPIN+1
SET ^TMP("BDMEPI",$JOB,BDMEPIN)=X
+4 QUIT
FLAT ;
+1 SET BDMFILE=""
+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 BDMSTP=1
QUIT
+4 IF X'?1.8AN
WRITE !!,"Invalid format, must be letters and numbers",!
GOTO FLAT
+5 SET BDMFILE=$$LOW^XLFSTR(Y)_".rec"
+6 WRITE !!,"I am going to create a file called ",BDMFILE," 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,"********** ",BDMFILE," **********",!
+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 ",BDMFILE
+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 BDMSTP=1
QUIT
+14 IF 'Y
SET BDMSTP=1
QUIT
+15 QUIT
CLEAN ;
+1 KILL BDMPD,BDMPT,^TMP("BDMPTS",$JOB),BDMPREP,BDMPTS,BDMEPIN
+2 QUIT
+3 ;
EOJ ;
+1 IF IO'=IO(0)
DO ^%ZISC
+2 KILL BDMFISC,BDMPD,BDMPT,BDMDATE,BDMSTP,BDMDTE,BDMEDT,BDMBDT,BDMTDTE,BDMDFN,BDMROOT,^TMP("BDMPTS",$JOB),BDMASK,AUPNSEX,AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOD,AUPNDOB,BDMPREP,BDMEPIN,BDMED,BDMMAM,BDMED,BDMBD,BDMUED,ZTCPU
+3 KILL BDMHTKI,BDMRXC1
+4 QUIT
+5 ;
