PXRMGECP ;SLC/JVS -GEC-Prompts ;7/14/05 10:43
;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
Q
EN ;Entry Point
;^DISV( = DBIA #510
N POP,DIROUT,DIRUT,DUOUT,LOCNP,MENU,PROV,Y
N DETAIL,FORMAT,INC
;D INIT^PXRMGECW
S X="IOUON;IOUOFF;IORVOFF;IORVON" D ENDR^%ZISS
W IOUOFF,IORVOFF
W @IOF
W !,"All Reports will print on 80 Columns"
K DIR
S DIR("A")="Select Option or ^ to Exit"
I $D(^DISV(DUZ,"PXRMGEC","EN")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","EN"))
S DIR(0)="S^1:Category;2:Patient;3:Provider by Patient;4:Referral Date;5:Location;6:Referral Count Totals;7:Category-Referred Service;8:Summary (Score);9:'Home Help' Eligibility;10:Restore or Merge Referrals"
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
Q:$D(DIRUT)!($D(DIROUT))
;DBIA #510
S MENU=Y,^DISV(DUZ,"PXRMGEC","EN")=MENU
I MENU=1 D CAT
I MENU=2 D PATIENT
I MENU=3 D PRO
I MENU=4 D DR
I MENU=5 D LOCDIR^PXRMGECO
I MENU=6 D CT^PXRMGECO
I MENU=7 D RS^PXRMGECO
I MENU=8 D SUM^PXRMGECO
I MENU=9 D HOME^PXRMG2R2
I MENU=10 D EN^PXRMGECJ
D KILL^%ZISS
Q
;==========================================================
;
CAT ;#1 Start List and array of GEC Categories
;
N CAT,CATNA,CNT,STAY,NUM,CATIEN,CATARY,BDT,EDT,CATDA,SYN
W @IOF
W "GEC Referral Categories"
S CNT=0
S SYN="" F S SYN=$O(^AUTTHF("D",SYN)) Q:SYN="" D
.I $E(SYN,1,3)="GEC",$E(SYN,5)="C" D
..S CAT=0 F S CAT=$O(^AUTTHF("D",SYN,CAT)) Q:CAT="" D
...Q:$P($G(^AUTTHF(CAT,0)),"^",11)=1
...S CATNA=$P($G(^AUTTHF(CAT,0)),"^",1)
...S CATNA=$P(CATNA," ",3,7)
...S CATARY(CATNA,CAT)=""
S CATNA="" F S CATNA=$O(CATARY(CATNA)) Q:CATNA="" D
.S CAT=$O(CATARY(CATNA,0))
.S CNT=CNT+1
.S CATDA(CNT,CAT)=""
.W:CNT#2=1 !,CNT,?4,CATNA
.W:CNT#2=0 ?35,CNT,?39,CATNA
SC ;=====Select Categories
W !
S DIR("A",1)="Select Categories from the list above using"
S DIR("A",2)="Commas and/or Dashes for ranges of numbers."
S DIR("A")="Select Categories or ^ to exit"
I $D(^DISV(DUZ,"PXRMGEC","SC")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","SC"))
S DIR(0)="L^1:"_CNT
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
Q:$D(DIROUT)
Q:$D(DIRUT)
S ^DISV(DUZ,"PXRMGEC","SC")=X
N LEN,IME,MEY
S LEN=$L(Y,",")
S MEY=0 F IME=1:1:LEN-1 S MEY=$P(Y,",",IME) D
.S CATMEY(MEY)=""
S STAY=0 F S STAY=$O(CATDA(STAY)) Q:STAY="" D
.I '$D(CATMEY(STAY)) K CATDA(STAY)
S NUM=0 F S NUM=$O(CATDA(NUM)) Q:NUM="" D
.S CATIEN($O(CATDA(NUM,0)))=""
K CATDA,CATMEY
CATBDT D BDT Q:$D(DIROUT)!$D(DIRUT)
CATEDT D EDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CATBDT
CATPAT D PAT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CATEDT
CATFOR D FOR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CATPAT
CATIOO D CATIO Q:$D(DIROUT)
Q
BDT ;=====Select Beginning Date
;--Return BDT as DATE
W !
S DIR("A",1)="Select a Beginning Historical Date."
S DIR("A")="BEGINNING date or ^ to exit"
I $D(^DISV(DUZ,"PXRMGEC","BDT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","BDT"))
S DIR(0)="D^2880101:"_DT_":EX"
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
Q:$D(DIROUT)!($D(DIRUT))
S ^DISV(DUZ,"PXRMGEC","BDT")=X
S BDT=Y
Q
;
EDT ;=====Select Ending Date
;--Return EDT as DATE
W !
S DIR("A",1)="Select Ending Date."
S DIR("A")="ENDING date or ^ to exit"
I $D(^DISV(DUZ,"PXRMGEC","EDT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","EDT"))
S DIR(0)="D^"_BDT_":"_DT_":EX"
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
Q:$D(DIROUT)!($D(DIRUT))
S ^DISV(DUZ,"PXRMGEC","EDT")=X
S EDT=Y
Q
;=====Select Patients
PAT ;--Return DFNONLY as Patient DFN
W @IOF
K DIR,DIR("A")
K DFNONLY
S DIR("A")="Select Patients or ^ to exit"
I $D(^DISV(DUZ,"PXRMGEC","PAT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","PAT"))
S DIR(0)="S^A:All Patients;M:Multiple Patients"
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
Q:$D(DIROUT)!($D(DIRUT))
S ^DISV(DUZ,"PXRMGEC","PAT")=X
I Y="A" S DFNONLY=0
I Y="M" D PATLU
Q
;
FOR ;=====Formatted or Delimited Report
;--Return FORMAT equal to Y
S DIR("A")="Select Report Format or ^ to exit"
I $D(^DISV(DUZ,"PXRMGEC","FOR")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","FOR"))
S DIR(0)="S^F:Formatted;D:Delimited"
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
Q:$D(DIRUT)!($D(DIROUT))
S ^DISV(DUZ,"PXRMGEC","FOR")=X
S FORMAT=Y
Q
;
CATIO ;=====Select IO device
Q:'$D(BDT)!('$D(EDT))!('$D(DFNONLY))!'$D(FORMAT)
N %ZIS
S %ZIS="QM" D ^%ZIS
I POP Q
I $D(IO("Q")) D
.S ZTRTN="HFCD^PXRMGECQ"
.S ZTDESC="Gec Report Printing"
.S ZTSAVE("*")=""
.D ^%ZTLOAD K IO("Q") Q
;=====Call Report
E D HFCD^PXRMGECR
D HOME^%ZIS
D ^%ZISC
S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
Q
;
;================SUB ROUTINES==============================
PROV ;Select Provider
W @IOF
N DIC,Y
S PROV=0
K PROVARY
S DIC="^VA(200,"
S DIC(0)="QAMEZ"
PROVR D ^DIC
I Y=-1 K DIC,DIC(0),Y Q
I +Y>0 S PROVARY(+Y)=""
S PROV=+Y
G PROVR
Q
;
PATLU ;Patient Look up
N Y,DIC
S DFNONLY=0
K DFNARY
S DIC="^DPT("
S DIC(0)="QAMEZ"
PATLUR D ^DIC
I Y=-1 K DIC,DIC(0),Y Q
I +Y>0 S DFNONLY=+Y,DFNARY(+Y)=""
G PATLUR
Q
;
;================================================================
PRO ; #3 Start of Provider by Patient Report
N BDT,EDT,DFNONLY
W @IOF
K DIR
I $D(^DISV(DUZ,"PXRMGEC","PRO")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","PRO"))
S DIR(0)="S^A:All Providers;M:Multiple Providers"
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
Q:$D(DIRUT)!($D(DUOUT))
Q:$D(DIROUT)
S ^DISV(DUZ,"PXRMGEC","PRO")=X
I Y="A" S PROV=0
I Y="M" D PROV Q:'$D(PROVARY)
Q:$D(DIRUT)!($D(DIROUT))
PROBDT D BDT Q:$D(DIRUT)!($D(DIRUT))
PROEDT D EDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PROBDT
PROFOR D FOR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PROEDT
PROIOO D PROIO Q:$D(DIROUT)
Q
;
PROIO ;=====Select IO device
N %ZIS
S %ZIS="QM" D ^%ZIS
I POP Q
I $D(IO("Q")) D
.S ZTRTN="DFN2^PXRMGECQ"
.S ZTDESC="GEC PROVIDER REPORT"
.S ZTSAVE("*")=""
.D ^%ZTLOAD K IO("Q") Q
;=====Call Report
E D DFN2^PXRMGECS
D HOME^%ZIS
D ^%ZISC
S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
Q
;=================================================================
DR ; #4 Referral Date
;
DRPAT D PAT Q:$D(DIROUT)!($D(DIRUT))
DRBDT D BDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G DRPAT
DREDT D EDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G DRBDT
DRALL D ALL Q:$D(DIROUT) I $D(DIRUT) K DIRUT G DREDT
DRFOR D FOR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G DRALL
DRIOO D DRIO Q:$D(DIROUT)
Q
;
ALL ;=====Select All Referrals or
;--Return INC equal to Y
I $D(^DISV(DUZ,"PXRMGEC","ALL")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","ALL"))
S DIR(0)="S^I:Incomplete Referrals Only;C:Complete Referrals Only;B:Both Complete and Incomplete"
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
Q:$D(DIRUT)!($D(DUOUT))
S ^DISV(DUZ,"PXRMGEC","ALL")=X
I Y="I" S INC=0
I Y="C" S INC=1
I Y="B" S INC=2
Q
;
DRIO ;=====Select IO device
N %ZIS
S %ZIS="QM" D ^%ZIS
I POP Q
I $D(IO("Q")) D
.S ZTRTN="DR^PXRMGECQ"
.S ZTDESC="GEC REPORT"
.S ZTSAVE("*")=""
.D ^%ZTLOAD K IO("Q") Q
;=====Call Report
E D DR^PXRMGECR
D HOME^%ZIS
D ^%ZISC
S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
Q
;
;==================================================================
PATIENT ; #2 Start of Patient Report
;
PATPAT D PAT Q:$D(DIROUT)!($D(DIRUT))
PATBDT D BDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PATPAT
PATEDT D EDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PATBDT
PATFOR D FOR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PATEDT
PATIOO D PATIO Q:$D(DIROUT)
Q
;
PATIO ;=====Select IO device for Patient Report
N %ZIS
S %ZIS="QM" D ^%ZIS
I POP Q
I $D(IO("Q")) D
.S ZTRTN="HS1^PXRMGECQ"
.S ZTDESC="GEC PATIENT REPORT"
.S ZTSAVE("*")=""
.S ZTSAVE("FORMAT")=""
.S ZTSAVE("EDT")=""
.S ZTSAVE("BDT")=""
.S ZTSAVE("DFNONLY")=""
.I $D(DFNARY) S ZTSAVE("DFNARY(")=""
.D ^%ZTLOAD K IO("Q") Q
;=====Call Report
E D HS1^PXRMGECR
D HOME^%ZIS
D ^%ZISC
S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
Q
;=========================================================
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMGECP 8059 printed Sep 23, 2025@19:21:46 Page 2
PXRMGECP ;SLC/JVS -GEC-Prompts ;7/14/05 10:43
+1 ;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
+2 QUIT
EN ;Entry Point
+1 ;^DISV( = DBIA #510
+2 NEW POP,DIROUT,DIRUT,DUOUT,LOCNP,MENU,PROV,Y
+3 NEW DETAIL,FORMAT,INC
+4 ;D INIT^PXRMGECW
+5 SET X="IOUON;IOUOFF;IORVOFF;IORVON"
DO ENDR^%ZISS
+6 WRITE IOUOFF,IORVOFF
+7 WRITE @IOF
+8 WRITE !,"All Reports will print on 80 Columns"
+9 KILL DIR
+10 SET DIR("A")="Select Option or ^ to Exit"
+11 IF $DATA(^DISV(DUZ,"PXRMGEC","EN"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","EN"))
+12 SET DIR(0)="S^1:Category;2:Patient;3:Provider by Patient;4:Referral Date;5:Location;6:Referral Count Totals;7:Category-Referred Service;8:Summary (Score);9:'Home Help' Eligibility;10:Restore or Merge Referrals"
+13 DO ^DIR
+14 KILL DIR("A"),DIR("B"),DIR(0)
+15 if $DATA(DIRUT)!($DATA(DIROUT))
QUIT
+16 ;DBIA #510
+17 SET MENU=Y
SET ^DISV(DUZ,"PXRMGEC","EN")=MENU
+18 IF MENU=1
DO CAT
+19 IF MENU=2
DO PATIENT
+20 IF MENU=3
DO PRO
+21 IF MENU=4
DO DR
+22 IF MENU=5
DO LOCDIR^PXRMGECO
+23 IF MENU=6
DO CT^PXRMGECO
+24 IF MENU=7
DO RS^PXRMGECO
+25 IF MENU=8
DO SUM^PXRMGECO
+26 IF MENU=9
DO HOME^PXRMG2R2
+27 IF MENU=10
DO EN^PXRMGECJ
+28 DO KILL^%ZISS
+29 QUIT
+30 ;==========================================================
+31 ;
CAT ;#1 Start List and array of GEC Categories
+1 ;
+2 NEW CAT,CATNA,CNT,STAY,NUM,CATIEN,CATARY,BDT,EDT,CATDA,SYN
+3 WRITE @IOF
+4 WRITE "GEC Referral Categories"
+5 SET CNT=0
+6 SET SYN=""
FOR
SET SYN=$ORDER(^AUTTHF("D",SYN))
if SYN=""
QUIT
Begin DoDot:1
+7 IF $EXTRACT(SYN,1,3)="GEC"
IF $EXTRACT(SYN,5)="C"
Begin DoDot:2
+8 SET CAT=0
FOR
SET CAT=$ORDER(^AUTTHF("D",SYN,CAT))
if CAT=""
QUIT
Begin DoDot:3
+9 if $PIECE($GET(^AUTTHF(CAT,0)),"^",11)=1
QUIT
+10 SET CATNA=$PIECE($GET(^AUTTHF(CAT,0)),"^",1)
+11 SET CATNA=$PIECE(CATNA," ",3,7)
+12 SET CATARY(CATNA,CAT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET CATNA=""
FOR
SET CATNA=$ORDER(CATARY(CATNA))
if CATNA=""
QUIT
Begin DoDot:1
+14 SET CAT=$ORDER(CATARY(CATNA,0))
+15 SET CNT=CNT+1
+16 SET CATDA(CNT,CAT)=""
+17 if CNT#2=1
WRITE !,CNT,?4,CATNA
+18 if CNT#2=0
WRITE ?35,CNT,?39,CATNA
End DoDot:1
SC ;=====Select Categories
+1 WRITE !
+2 SET DIR("A",1)="Select Categories from the list above using"
+3 SET DIR("A",2)="Commas and/or Dashes for ranges of numbers."
+4 SET DIR("A")="Select Categories or ^ to exit"
+5 IF $DATA(^DISV(DUZ,"PXRMGEC","SC"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","SC"))
+6 SET DIR(0)="L^1:"_CNT
+7 DO ^DIR
+8 KILL DIR("A"),DIR("B"),DIR(0)
+9 if $DATA(DIROUT)
QUIT
+10 if $DATA(DIRUT)
QUIT
+11 SET ^DISV(DUZ,"PXRMGEC","SC")=X
+12 NEW LEN,IME,MEY
+13 SET LEN=$LENGTH(Y,",")
+14 SET MEY=0
FOR IME=1:1:LEN-1
SET MEY=$PIECE(Y,",",IME)
Begin DoDot:1
+15 SET CATMEY(MEY)=""
End DoDot:1
+16 SET STAY=0
FOR
SET STAY=$ORDER(CATDA(STAY))
if STAY=""
QUIT
Begin DoDot:1
+17 IF '$DATA(CATMEY(STAY))
KILL CATDA(STAY)
End DoDot:1
+18 SET NUM=0
FOR
SET NUM=$ORDER(CATDA(NUM))
if NUM=""
QUIT
Begin DoDot:1
+19 SET CATIEN($ORDER(CATDA(NUM,0)))=""
End DoDot:1
+20 KILL CATDA,CATMEY
CATBDT DO BDT
if $DATA(DIROUT)!$DATA(DIRUT)
QUIT
CATEDT DO EDT
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO CATBDT
CATPAT DO PAT
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO CATEDT
CATFOR DO FOR
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO CATPAT
CATIOO DO CATIO
if $DATA(DIROUT)
QUIT
+1 QUIT
BDT ;=====Select Beginning Date
+1 ;--Return BDT as DATE
+2 WRITE !
+3 SET DIR("A",1)="Select a Beginning Historical Date."
+4 SET DIR("A")="BEGINNING date or ^ to exit"
+5 IF $DATA(^DISV(DUZ,"PXRMGEC","BDT"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","BDT"))
+6 SET DIR(0)="D^2880101:"_DT_":EX"
+7 DO ^DIR
+8 KILL DIR("A"),DIR("B"),DIR(0)
+9 if $DATA(DIROUT)!($DATA(DIRUT))
QUIT
+10 SET ^DISV(DUZ,"PXRMGEC","BDT")=X
+11 SET BDT=Y
+12 QUIT
+13 ;
EDT ;=====Select Ending Date
+1 ;--Return EDT as DATE
+2 WRITE !
+3 SET DIR("A",1)="Select Ending Date."
+4 SET DIR("A")="ENDING date or ^ to exit"
+5 IF $DATA(^DISV(DUZ,"PXRMGEC","EDT"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","EDT"))
+6 SET DIR(0)="D^"_BDT_":"_DT_":EX"
+7 DO ^DIR
+8 KILL DIR("A"),DIR("B"),DIR(0)
+9 if $DATA(DIROUT)!($DATA(DIRUT))
QUIT
+10 SET ^DISV(DUZ,"PXRMGEC","EDT")=X
+11 SET EDT=Y
+12 QUIT
+13 ;=====Select Patients
PAT ;--Return DFNONLY as Patient DFN
+1 WRITE @IOF
+2 KILL DIR,DIR("A")
+3 KILL DFNONLY
+4 SET DIR("A")="Select Patients or ^ to exit"
+5 IF $DATA(^DISV(DUZ,"PXRMGEC","PAT"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","PAT"))
+6 SET DIR(0)="S^A:All Patients;M:Multiple Patients"
+7 DO ^DIR
+8 KILL DIR("A"),DIR("B"),DIR(0)
+9 if $DATA(DIROUT)!($DATA(DIRUT))
QUIT
+10 SET ^DISV(DUZ,"PXRMGEC","PAT")=X
+11 IF Y="A"
SET DFNONLY=0
+12 IF Y="M"
DO PATLU
+13 QUIT
+14 ;
FOR ;=====Formatted or Delimited Report
+1 ;--Return FORMAT equal to Y
+2 SET DIR("A")="Select Report Format or ^ to exit"
+3 IF $DATA(^DISV(DUZ,"PXRMGEC","FOR"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","FOR"))
+4 SET DIR(0)="S^F:Formatted;D:Delimited"
+5 DO ^DIR
+6 KILL DIR("A"),DIR("B"),DIR(0)
+7 if $DATA(DIRUT)!($DATA(DIROUT))
QUIT
+8 SET ^DISV(DUZ,"PXRMGEC","FOR")=X
+9 SET FORMAT=Y
+10 QUIT
+11 ;
CATIO ;=====Select IO device
+1 if '$DATA(BDT)!('$DATA(EDT))!('$DATA(DFNONLY))!'$DATA(FORMAT)
QUIT
+2 NEW %ZIS
+3 SET %ZIS="QM"
DO ^%ZIS
+4 IF POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTRTN="HFCD^PXRMGECQ"
+7 SET ZTDESC="Gec Report Printing"
+8 SET ZTSAVE("*")=""
+9 DO ^%ZTLOAD
KILL IO("Q")
QUIT
End DoDot:1
+10 ;=====Call Report
+11 IF '$TEST
DO HFCD^PXRMGECR
+12 DO HOME^%ZIS
+13 DO ^%ZISC
+14 if '$DATA(DIRUT)&('$DATA(DUOUT))&('$DATA(DIROUT))
SET DIR(0)="E"
DO ^DIR
KILL DIR(0),Y
+15 QUIT
+16 ;
+17 ;================SUB ROUTINES==============================
PROV ;Select Provider
+1 WRITE @IOF
+2 NEW DIC,Y
+3 SET PROV=0
+4 KILL PROVARY
+5 SET DIC="^VA(200,"
+6 SET DIC(0)="QAMEZ"
PROVR DO ^DIC
+1 IF Y=-1
KILL DIC,DIC(0),Y
QUIT
+2 IF +Y>0
SET PROVARY(+Y)=""
+3 SET PROV=+Y
+4 GOTO PROVR
+5 QUIT
+6 ;
PATLU ;Patient Look up
+1 NEW Y,DIC
+2 SET DFNONLY=0
+3 KILL DFNARY
+4 SET DIC="^DPT("
+5 SET DIC(0)="QAMEZ"
PATLUR DO ^DIC
+1 IF Y=-1
KILL DIC,DIC(0),Y
QUIT
+2 IF +Y>0
SET DFNONLY=+Y
SET DFNARY(+Y)=""
+3 GOTO PATLUR
+4 QUIT
+5 ;
+6 ;================================================================
PRO ; #3 Start of Provider by Patient Report
+1 NEW BDT,EDT,DFNONLY
+2 WRITE @IOF
+3 KILL DIR
+4 IF $DATA(^DISV(DUZ,"PXRMGEC","PRO"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","PRO"))
+5 SET DIR(0)="S^A:All Providers;M:Multiple Providers"
+6 DO ^DIR
+7 KILL DIR("A"),DIR("B"),DIR(0)
+8 if $DATA(DIRUT)!($DATA(DUOUT))
QUIT
+9 if $DATA(DIROUT)
QUIT
+10 SET ^DISV(DUZ,"PXRMGEC","PRO")=X
+11 IF Y="A"
SET PROV=0
+12 IF Y="M"
DO PROV
if '$DATA(PROVARY)
QUIT
+13 if $DATA(DIRUT)!($DATA(DIROUT))
QUIT
PROBDT DO BDT
if $DATA(DIRUT)!($DATA(DIRUT))
QUIT
PROEDT DO EDT
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO PROBDT
PROFOR DO FOR
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO PROEDT
PROIOO DO PROIO
if $DATA(DIROUT)
QUIT
+1 QUIT
+2 ;
PROIO ;=====Select IO device
+1 NEW %ZIS
+2 SET %ZIS="QM"
DO ^%ZIS
+3 IF POP
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTRTN="DFN2^PXRMGECQ"
+6 SET ZTDESC="GEC PROVIDER REPORT"
+7 SET ZTSAVE("*")=""
+8 DO ^%ZTLOAD
KILL IO("Q")
QUIT
End DoDot:1
+9 ;=====Call Report
+10 IF '$TEST
DO DFN2^PXRMGECS
+11 DO HOME^%ZIS
+12 DO ^%ZISC
+13 if '$DATA(DIRUT)&('$DATA(DUOUT))&('$DATA(DIROUT))
SET DIR(0)="E"
DO ^DIR
KILL DIR(0),Y
+14 QUIT
+15 ;=================================================================
DR ; #4 Referral Date
+1 ;
DRPAT DO PAT
if $DATA(DIROUT)!($DATA(DIRUT))
QUIT
DRBDT DO BDT
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO DRPAT
DREDT DO EDT
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO DRBDT
DRALL DO ALL
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO DREDT
DRFOR DO FOR
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO DRALL
DRIOO DO DRIO
if $DATA(DIROUT)
QUIT
+1 QUIT
+2 ;
ALL ;=====Select All Referrals or
+1 ;--Return INC equal to Y
+2 IF $DATA(^DISV(DUZ,"PXRMGEC","ALL"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","ALL"))
+3 SET DIR(0)="S^I:Incomplete Referrals Only;C:Complete Referrals Only;B:Both Complete and Incomplete"
+4 DO ^DIR
+5 KILL DIR("A"),DIR("B"),DIR(0)
+6 if $DATA(DIRUT)!($DATA(DUOUT))
QUIT
+7 SET ^DISV(DUZ,"PXRMGEC","ALL")=X
+8 IF Y="I"
SET INC=0
+9 IF Y="C"
SET INC=1
+10 IF Y="B"
SET INC=2
+11 QUIT
+12 ;
DRIO ;=====Select IO device
+1 NEW %ZIS
+2 SET %ZIS="QM"
DO ^%ZIS
+3 IF POP
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTRTN="DR^PXRMGECQ"
+6 SET ZTDESC="GEC REPORT"
+7 SET ZTSAVE("*")=""
+8 DO ^%ZTLOAD
KILL IO("Q")
QUIT
End DoDot:1
+9 ;=====Call Report
+10 IF '$TEST
DO DR^PXRMGECR
+11 DO HOME^%ZIS
+12 DO ^%ZISC
+13 if '$DATA(DIRUT)&('$DATA(DUOUT))&('$DATA(DIROUT))
SET DIR(0)="E"
DO ^DIR
KILL DIR(0),Y
+14 QUIT
+15 ;
+16 ;==================================================================
PATIENT ; #2 Start of Patient Report
+1 ;
PATPAT DO PAT
if $DATA(DIROUT)!($DATA(DIRUT))
QUIT
PATBDT DO BDT
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO PATPAT
PATEDT DO EDT
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO PATBDT
PATFOR DO FOR
if $DATA(DIROUT)
QUIT
IF $DATA(DIRUT)
KILL DIRUT
GOTO PATEDT
PATIOO DO PATIO
if $DATA(DIROUT)
QUIT
+1 QUIT
+2 ;
PATIO ;=====Select IO device for Patient Report
+1 NEW %ZIS
+2 SET %ZIS="QM"
DO ^%ZIS
+3 IF POP
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTRTN="HS1^PXRMGECQ"
+6 SET ZTDESC="GEC PATIENT REPORT"
+7 SET ZTSAVE("*")=""
+8 SET ZTSAVE("FORMAT")=""
+9 SET ZTSAVE("EDT")=""
+10 SET ZTSAVE("BDT")=""
+11 SET ZTSAVE("DFNONLY")=""
+12 IF $DATA(DFNARY)
SET ZTSAVE("DFNARY(")=""
+13 DO ^%ZTLOAD
KILL IO("Q")
QUIT
End DoDot:1
+14 ;=====Call Report
+15 IF '$TEST
DO HS1^PXRMGECR
+16 DO HOME^%ZIS
+17 DO ^%ZISC
+18 if '$DATA(DIRUT)&('$DATA(DUOUT))&('$DATA(DIROUT))
SET DIR(0)="E"
DO ^DIR
KILL DIR(0),Y
+19 QUIT
+20 ;=========================================================
