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

PXRMGECP.m

Go to the documentation of this file.
  1. PXRMGECP ;SLC/JVS -GEC-Prompts ;7/14/05 10:43
  1. ;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
  1. Q
  1. EN ;Entry Point
  1. ;^DISV( = DBIA #510
  1. N POP,DIROUT,DIRUT,DUOUT,LOCNP,MENU,PROV,Y
  1. N DETAIL,FORMAT,INC
  1. ;D INIT^PXRMGECW
  1. S X="IOUON;IOUOFF;IORVOFF;IORVON" D ENDR^%ZISS
  1. W IOUOFF,IORVOFF
  1. W @IOF
  1. W !,"All Reports will print on 80 Columns"
  1. K DIR
  1. S DIR("A")="Select Option or ^ to Exit"
  1. I $D(^DISV(DUZ,"PXRMGEC","EN")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","EN"))
  1. 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"
  1. D ^DIR
  1. K DIR("A"),DIR("B"),DIR(0)
  1. Q:$D(DIRUT)!($D(DIROUT))
  1. ;DBIA #510
  1. S MENU=Y,^DISV(DUZ,"PXRMGEC","EN")=MENU
  1. I MENU=1 D CAT
  1. I MENU=2 D PATIENT
  1. I MENU=3 D PRO
  1. I MENU=4 D DR
  1. I MENU=5 D LOCDIR^PXRMGECO
  1. I MENU=6 D CT^PXRMGECO
  1. I MENU=7 D RS^PXRMGECO
  1. I MENU=8 D SUM^PXRMGECO
  1. I MENU=9 D HOME^PXRMG2R2
  1. I MENU=10 D EN^PXRMGECJ
  1. D KILL^%ZISS
  1. Q
  1. ;==========================================================
  1. ;
  1. CAT ;#1 Start List and array of GEC Categories
  1. ;
  1. N CAT,CATNA,CNT,STAY,NUM,CATIEN,CATARY,BDT,EDT,CATDA,SYN
  1. W @IOF
  1. W "GEC Referral Categories"
  1. S CNT=0
  1. S SYN="" F S SYN=$O(^AUTTHF("D",SYN)) Q:SYN="" D
  1. .I $E(SYN,1,3)="GEC",$E(SYN,5)="C" D
  1. ..S CAT=0 F S CAT=$O(^AUTTHF("D",SYN,CAT)) Q:CAT="" D
  1. ...Q:$P($G(^AUTTHF(CAT,0)),"^",11)=1
  1. ...S CATNA=$P($G(^AUTTHF(CAT,0)),"^",1)
  1. ...S CATNA=$P(CATNA," ",3,7)
  1. ...S CATARY(CATNA,CAT)=""
  1. S CATNA="" F S CATNA=$O(CATARY(CATNA)) Q:CATNA="" D
  1. .S CAT=$O(CATARY(CATNA,0))
  1. .S CNT=CNT+1
  1. .S CATDA(CNT,CAT)=""
  1. .W:CNT#2=1 !,CNT,?4,CATNA
  1. .W:CNT#2=0 ?35,CNT,?39,CATNA
  1. SC ;=====Select Categories
  1. W !
  1. S DIR("A",1)="Select Categories from the list above using"
  1. S DIR("A",2)="Commas and/or Dashes for ranges of numbers."
  1. S DIR("A")="Select Categories or ^ to exit"
  1. I $D(^DISV(DUZ,"PXRMGEC","SC")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","SC"))
  1. S DIR(0)="L^1:"_CNT
  1. D ^DIR
  1. K DIR("A"),DIR("B"),DIR(0)
  1. Q:$D(DIROUT)
  1. Q:$D(DIRUT)
  1. S ^DISV(DUZ,"PXRMGEC","SC")=X
  1. N LEN,IME,MEY
  1. S LEN=$L(Y,",")
  1. S MEY=0 F IME=1:1:LEN-1 S MEY=$P(Y,",",IME) D
  1. .S CATMEY(MEY)=""
  1. S STAY=0 F S STAY=$O(CATDA(STAY)) Q:STAY="" D
  1. .I '$D(CATMEY(STAY)) K CATDA(STAY)
  1. S NUM=0 F S NUM=$O(CATDA(NUM)) Q:NUM="" D
  1. .S CATIEN($O(CATDA(NUM,0)))=""
  1. K CATDA,CATMEY
  1. CATBDT D BDT Q:$D(DIROUT)!$D(DIRUT)
  1. CATEDT D EDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CATBDT
  1. CATPAT D PAT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CATEDT
  1. CATFOR D FOR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CATPAT
  1. CATIOO D CATIO Q:$D(DIROUT)
  1. Q
  1. BDT ;=====Select Beginning Date
  1. ;--Return BDT as DATE
  1. W !
  1. S DIR("A",1)="Select a Beginning Historical Date."
  1. S DIR("A")="BEGINNING date or ^ to exit"
  1. I $D(^DISV(DUZ,"PXRMGEC","BDT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","BDT"))
  1. S DIR(0)="D^2880101:"_DT_":EX"
  1. D ^DIR
  1. K DIR("A"),DIR("B"),DIR(0)
  1. Q:$D(DIROUT)!($D(DIRUT))
  1. S ^DISV(DUZ,"PXRMGEC","BDT")=X
  1. S BDT=Y
  1. Q
  1. ;
  1. EDT ;=====Select Ending Date
  1. ;--Return EDT as DATE
  1. W !
  1. S DIR("A",1)="Select Ending Date."
  1. S DIR("A")="ENDING date or ^ to exit"
  1. I $D(^DISV(DUZ,"PXRMGEC","EDT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","EDT"))
  1. S DIR(0)="D^"_BDT_":"_DT_":EX"
  1. D ^DIR
  1. K DIR("A"),DIR("B"),DIR(0)
  1. Q:$D(DIROUT)!($D(DIRUT))
  1. S ^DISV(DUZ,"PXRMGEC","EDT")=X
  1. S EDT=Y
  1. Q
  1. ;=====Select Patients
  1. PAT ;--Return DFNONLY as Patient DFN
  1. W @IOF
  1. K DIR,DIR("A")
  1. K DFNONLY
  1. S DIR("A")="Select Patients or ^ to exit"
  1. I $D(^DISV(DUZ,"PXRMGEC","PAT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","PAT"))
  1. S DIR(0)="S^A:All Patients;M:Multiple Patients"
  1. D ^DIR
  1. K DIR("A"),DIR("B"),DIR(0)
  1. Q:$D(DIROUT)!($D(DIRUT))
  1. S ^DISV(DUZ,"PXRMGEC","PAT")=X
  1. I Y="A" S DFNONLY=0
  1. I Y="M" D PATLU
  1. Q
  1. ;
  1. FOR ;=====Formatted or Delimited Report
  1. ;--Return FORMAT equal to Y
  1. S DIR("A")="Select Report Format or ^ to exit"
  1. I $D(^DISV(DUZ,"PXRMGEC","FOR")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","FOR"))
  1. S DIR(0)="S^F:Formatted;D:Delimited"
  1. D ^DIR
  1. K DIR("A"),DIR("B"),DIR(0)
  1. Q:$D(DIRUT)!($D(DIROUT))
  1. S ^DISV(DUZ,"PXRMGEC","FOR")=X
  1. S FORMAT=Y
  1. Q
  1. ;
  1. CATIO ;=====Select IO device
  1. Q:'$D(BDT)!('$D(EDT))!('$D(DFNONLY))!'$D(FORMAT)
  1. N %ZIS
  1. S %ZIS="QM" D ^%ZIS
  1. I POP Q
  1. I $D(IO("Q")) D
  1. .S ZTRTN="HFCD^PXRMGECQ"
  1. .S ZTDESC="Gec Report Printing"
  1. .S ZTSAVE("*")=""
  1. .D ^%ZTLOAD K IO("Q") Q
  1. ;=====Call Report
  1. E D HFCD^PXRMGECR
  1. D HOME^%ZIS
  1. D ^%ZISC
  1. S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
  1. Q
  1. ;
  1. ;================SUB ROUTINES==============================
  1. PROV ;Select Provider
  1. W @IOF
  1. N DIC,Y
  1. S PROV=0
  1. K PROVARY
  1. S DIC="^VA(200,"
  1. S DIC(0)="QAMEZ"
  1. PROVR D ^DIC
  1. I Y=-1 K DIC,DIC(0),Y Q
  1. I +Y>0 S PROVARY(+Y)=""
  1. S PROV=+Y
  1. G PROVR
  1. Q
  1. ;
  1. PATLU ;Patient Look up
  1. N Y,DIC
  1. S DFNONLY=0
  1. K DFNARY
  1. S DIC="^DPT("
  1. S DIC(0)="QAMEZ"
  1. PATLUR D ^DIC
  1. I Y=-1 K DIC,DIC(0),Y Q
  1. I +Y>0 S DFNONLY=+Y,DFNARY(+Y)=""
  1. G PATLUR
  1. Q
  1. ;
  1. ;================================================================
  1. PRO ; #3 Start of Provider by Patient Report
  1. N BDT,EDT,DFNONLY
  1. W @IOF
  1. K DIR
  1. I $D(^DISV(DUZ,"PXRMGEC","PRO")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","PRO"))
  1. S DIR(0)="S^A:All Providers;M:Multiple Providers"
  1. D ^DIR
  1. K DIR("A"),DIR("B"),DIR(0)
  1. Q:$D(DIRUT)!($D(DUOUT))
  1. Q:$D(DIROUT)
  1. S ^DISV(DUZ,"PXRMGEC","PRO")=X
  1. I Y="A" S PROV=0
  1. I Y="M" D PROV Q:'$D(PROVARY)
  1. Q:$D(DIRUT)!($D(DIROUT))
  1. PROBDT D BDT Q:$D(DIRUT)!($D(DIRUT))
  1. PROEDT D EDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PROBDT
  1. PROFOR D FOR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PROEDT
  1. PROIOO D PROIO Q:$D(DIROUT)
  1. Q
  1. ;
  1. PROIO ;=====Select IO device
  1. N %ZIS
  1. S %ZIS="QM" D ^%ZIS
  1. I POP Q
  1. I $D(IO("Q")) D
  1. .S ZTRTN="DFN2^PXRMGECQ"
  1. .S ZTDESC="GEC PROVIDER REPORT"
  1. .S ZTSAVE("*")=""
  1. .D ^%ZTLOAD K IO("Q") Q
  1. ;=====Call Report
  1. E D DFN2^PXRMGECS
  1. D HOME^%ZIS
  1. D ^%ZISC
  1. S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
  1. Q
  1. ;=================================================================
  1. DR ; #4 Referral Date
  1. ;
  1. DRPAT D PAT Q:$D(DIROUT)!($D(DIRUT))
  1. DRBDT D BDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G DRPAT
  1. DREDT D EDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G DRBDT
  1. DRALL D ALL Q:$D(DIROUT) I $D(DIRUT) K DIRUT G DREDT
  1. DRFOR D FOR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G DRALL
  1. DRIOO D DRIO Q:$D(DIROUT)
  1. Q
  1. ;
  1. ALL ;=====Select All Referrals or
  1. ;--Return INC equal to Y
  1. I $D(^DISV(DUZ,"PXRMGEC","ALL")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","ALL"))
  1. S DIR(0)="S^I:Incomplete Referrals Only;C:Complete Referrals Only;B:Both Complete and Incomplete"
  1. D ^DIR
  1. K DIR("A"),DIR("B"),DIR(0)
  1. Q:$D(DIRUT)!($D(DUOUT))
  1. S ^DISV(DUZ,"PXRMGEC","ALL")=X
  1. I Y="I" S INC=0
  1. I Y="C" S INC=1
  1. I Y="B" S INC=2
  1. Q
  1. ;
  1. DRIO ;=====Select IO device
  1. N %ZIS
  1. S %ZIS="QM" D ^%ZIS
  1. I POP Q
  1. I $D(IO("Q")) D
  1. .S ZTRTN="DR^PXRMGECQ"
  1. .S ZTDESC="GEC REPORT"
  1. .S ZTSAVE("*")=""
  1. .D ^%ZTLOAD K IO("Q") Q
  1. ;=====Call Report
  1. E D DR^PXRMGECR
  1. D HOME^%ZIS
  1. D ^%ZISC
  1. S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
  1. Q
  1. ;
  1. ;==================================================================
  1. PATIENT ; #2 Start of Patient Report
  1. ;
  1. PATPAT D PAT Q:$D(DIROUT)!($D(DIRUT))
  1. PATBDT D BDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PATPAT
  1. PATEDT D EDT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PATBDT
  1. PATFOR D FOR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G PATEDT
  1. PATIOO D PATIO Q:$D(DIROUT)
  1. Q
  1. ;
  1. PATIO ;=====Select IO device for Patient Report
  1. N %ZIS
  1. S %ZIS="QM" D ^%ZIS
  1. I POP Q
  1. I $D(IO("Q")) D
  1. .S ZTRTN="HS1^PXRMGECQ"
  1. .S ZTDESC="GEC PATIENT REPORT"
  1. .S ZTSAVE("*")=""
  1. .S ZTSAVE("FORMAT")=""
  1. .S ZTSAVE("EDT")=""
  1. .S ZTSAVE("BDT")=""
  1. .S ZTSAVE("DFNONLY")=""
  1. .I $D(DFNARY) S ZTSAVE("DFNARY(")=""
  1. .D ^%ZTLOAD K IO("Q") Q
  1. ;=====Call Report
  1. E D HS1^PXRMGECR
  1. D HOME^%ZIS
  1. D ^%ZISC
  1. S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
  1. Q
  1. ;=========================================================