GMRCCA ;SFVAMC/DAD - Consult Closure Tool: Report Prompting ;01/20/17 15:19
;;3.0;CONSULT/REQUEST TRACKING;**89**;DEC 27, 1997;Build 62
;Consult Closure Tool
; IA# Usage Component
; ---------------------------
; 4836 Private ^DIC(40.7
; 510 Controlled ^DISV(
; 1519 Supported EN^XUTMDEVQ
; 2056 Supported $$GET1^DIQ
; 2608 Supported $$TEST^DDBRT
; 10024 Supported WAIT^DICD
; 10026 Supported ^DIR
; 10063 Supported ^%ZTLOAD
; 10103 Supported $$DT^XLFDT
; 10104 Supported $$TRIM^XLFSTR
; 10150 Supported HLP^DDSUTL
;
EN ;
; *** Interactive entry point
N GM0CFG,GMAPPT,GMDLIM,GMHEAD,GMAUTO,GMNOTE,GMOKAY
N GMOPUT,GMTBEG,GMTEAM,GMTEXT,GMTEND,GMXLAT
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
N X,Y,ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL
N ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
S GMAUTO=0 ; 0-disable/1-enable consult auto update (***DO NOT ENABLE***)
;
;
K DIR
S DIR(0)="POAr^123.033:AEMNQZ"
S DIR("A")="Select CONSULT CONFIGURATION: "
S GM0CFG=$G(^DISV(DUZ,$$GLOBROOT^GMRCCD(123.033)))
I $$CHKCFG(+GM0CFG,1)>0 D
. S DIR("B")=$$GET1^DIQ(123.033,+GM0CFG,.01)
. Q
S DIR("S")="I $$CHKCFG^GMRCCA(+Y,1)>0"
W ! D ^DIR S GM0CFG=+$G(Y)
I $$DIREXIT>0 G EXIT
;
S GMHEAD="Select a consult date range"
D LASTMNTH^GMRCCY($$DT^XLFDT,.GMTBEG,.GMTEND)
W ! I $$EN^GMRCCY(.GMTBEG,.GMTEND,GMHEAD,"U")'>0 G EXIT
;
K DIR
S DIR(0)="SOA^1:Seen in clinic;0:Not seen in clinic;"
S DIR("A",1)="Select an appointment status for the report"
S DIR("A",2)=" "
S DIR("A",3)=" 1 - Seen in clinic"
S DIR("A",4)=" 0 - Not seen in clinic"
S DIR("A",5)=" "
S DIR("A")="Select APPOINTMENT STATUS: "
S DIR("B")=1
W ! D ^DIR S GMAPPT=+$G(Y)
I $$DIREXIT>0 G EXIT
;
K DIR
S DIR(0)="SOA^1:Has a note;0:Does not have a note;"
S DIR("A",1)="Select a note status for the report"
S DIR("A",2)=" "
S DIR("A",3)=" 1 - Has a note"
S DIR("A",4)=" 0 - Does not have a note"
S DIR("A",5)=" "
S DIR("A")="Select NOTE STATUS: "
S DIR("B")=1
W ! D ^DIR S GMNOTE=+$G(Y)
I $$DIREXIT>0 G EXIT
;
S GMOPUT=0,GMXLAT=""
I GMNOTE>0 D G:$$DIREXIT>0 EXIT
. K DIR
. S DIR(0)="YAO"
. S DIR("A")="Interactive consult update: "
. S DIR("B")="Yes"
. W ! D ^DIR S GMOPUT=+$G(Y)
. S GMXLAT="1^I"
. I GMOPUT>0 I $$TEST^DDBRT'>0 D
.. K GMTEXT
.. S GMTEXT(1)="*** The VA FileMan browser is not supported by your terminal type ***"
.. S GMTEXT(2)="*** You cannot use the interactive consult update on this terminal ***"
.. S GMTEXT="*** You may print the consult report and/or update the CPRS team ***"
.. D HANGMSG^GMRCCD(.GMTEXT,3,1)
.. S GMOPUT=0,GMXLAT=""
.. Q
. Q
;
I GMOPUT'>0 D G:$$DIREXIT>0 EXIT
. S GMTEAM=$$ISTM^GMRCCD(GM0CFG)
. K DIR
. S DIR(0)="LOA^1:1:0"
. S DIR("A")="Select OUTPUT TYPE: "
. S DIR("A",1)="Select the output type for the report"
. S DIR("A",2)=" "
. S DIR("A",3)=" 1 - Print report"
. S DIR("B")="1"
. S GMXLAT="1^P"
. I GMTEAM>0 D
.. S DIR(0)="LOA^1:2:0"
.. S DIR("A",4)=" 2 - Team update"
.. S DIR("B")="1,2"
.. S GMXLAT="12^PT"
.. Q
. I (GMAUTO>0)&(GMNOTE>0) D
.. S DIR(0)="LOA^1:2:0"
.. S DIR("A",4)=" 2 - Consult update"
.. S DIR("B")="1,2"
.. S GMXLAT="12^PC"
.. Q
. I (GMAUTO>0)&(GMTEAM>0)&(GMNOTE>0) D
.. S DIR(0)="LOA^1:3:0"
.. S DIR("A",4)=" 2 - Team update"
.. S DIR("A",5)=" 3 - Consult update"
.. S DIR("B")="1-3"
.. S GMXLAT="123^PTC"
.. Q
. S DIR("A",1+$O(DIR("A",1E25),-1))=" "
. W ! D ^DIR S GMOPUT=$G(Y)
. Q
S GMOPUT=$$TRIM^XLFSTR(GMOPUT,"LR",",")
S GMOPUT=$TR(GMOPUT,$P(GMXLAT,U,1),$P(GMXLAT,U,2))
;
I GMOPUT["P" D G:$$DIREXIT>0 EXIT
. K DIR
. S DIR(0)="YOA"
. S DIR("A")="Delimited output: "
. S DIR("B")="No"
. W ! D ^DIR S GMDLIM=+$G(Y)
. Q
E D
. S GMDLIM=0
. Q
;
W !
S ZTRTN="TASK^GMRCCA("_GMTBEG_","_GMTEND_","
S ZTRTN=ZTRTN_GM0CFG_","_GMAPPT_","_GMNOTE_","""
S ZTRTN=ZTRTN_GMOPUT_""","_GMDLIM_")"
S ZTDESC="Consult Closure Tool"
I GMOPUT["P" D
. W !,"This report requires a 132 column output device"
. D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"MQ",1)
. Q
E D
. I GMOPUT["I" D
.. W !,"Searching for patient consults / appointments / notes",!
.. D WAIT^DICD
.. D @ZTRTN
.. Q
. E D
.. S ZTIO=""
.. D ^%ZTLOAD
.. Q
. Q
I $G(ZTSK)>0 W !,"Task #",ZTSK
;
EXIT ;
; *** Common exit point
Q
;
TASK(GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM) ;
; *** TaskMan entry point
N GMROOT
S GMROOT=$NA(^TMP($T(+0),$J))
K @GMROOT
D GETDATA^GMRCCB(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM)
I GMOPUT["C" D
. D CONSUPDT^GMRCCC(GMROOT)
. Q
I GMOPUT["T" D
. D MAKETEAM^GMRCCC(GMROOT,GM0CFG)
. Q
I GMOPUT["P" D
. D PRNTDATA^GMRCCC(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMDLIM)
. Q
I GMOPUT["I" D
. D INTERACT^GMRCCD(GMROOT)
. Q
K @GMROOT
Q
;
CHKCFG(GM0CFG,GMINAC) ;
; *** Screen for valid consult configuration
; GMDATA("XXX")=1 says XXX field is not populated
N GMDATA,GMOKAY
S GMOKAY=1
I (GMINAC>0)&($$GET1^DIQ(123.033,GM0CFG,.02,"I")>0) S GMOKAY=0
I $$GET1^DIQ(123.033,GM0CFG,.04)'>0 S GMOKAY=0
I $$GET1^DIQ(123.033,GM0CFG,.05)'>0 S GMOKAY=0
S GMDATA("STOP")=($$GET1^DIQ(123.033,GM0CFG,.06,"I")'>0)
F GMDATA="CLIN","CLPR","CONP","CONS","NOTE","PROT" D
. S GMDATA(GMDATA)=($O(^GMR(123.033,GM0CFG,GMDATA,0))'>0)
. Q
I (GMDATA("CLPR"))&(GMDATA("CONP"))&(GMDATA("CONS"))&(GMDATA("PROT")) S GMOKAY=0
I (GMDATA("CLIN"))&(GMDATA("STOP")) S GMOKAY=0
I GMDATA("NOTE") S GMOKAY=0
Q GMOKAY
;
DIREXIT() ;
; *** DIR exit status
Q $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)
;
POSTSAVE(GM0CFG) ;
; *** Post-save code for config editor
N GMTEXT
I $$CHKCFG(+GM0CFG,0)'>0 D
. S GMTEXT(1)="* * * The consult configuration is incomplete, required data is missing. * * *"
. S GMTEXT(2)="* * * You must enter a Config Name, Days Cons->Appt, Days Appt->Note, * * *"
. S GMTEXT(3)="* * * at least one type of Consult (Service, Procedure, etc.), at least * * *"
. S GMTEXT(4)="* * * one Clinic and/or a Stop Code, and at least one Note Title. * * *"
. S GMTEXT(5)="$$EOP"
. D HLP^DDSUTL(.GMTEXT)
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCCA 6204 printed Dec 13, 2024@01:45:12 Page 2
GMRCCA ;SFVAMC/DAD - Consult Closure Tool: Report Prompting ;01/20/17 15:19
+1 ;;3.0;CONSULT/REQUEST TRACKING;**89**;DEC 27, 1997;Build 62
+2 ;Consult Closure Tool
+3 ; IA# Usage Component
+4 ; ---------------------------
+5 ; 4836 Private ^DIC(40.7
+6 ; 510 Controlled ^DISV(
+7 ; 1519 Supported EN^XUTMDEVQ
+8 ; 2056 Supported $$GET1^DIQ
+9 ; 2608 Supported $$TEST^DDBRT
+10 ; 10024 Supported WAIT^DICD
+11 ; 10026 Supported ^DIR
+12 ; 10063 Supported ^%ZTLOAD
+13 ; 10103 Supported $$DT^XLFDT
+14 ; 10104 Supported $$TRIM^XLFSTR
+15 ; 10150 Supported HLP^DDSUTL
+16 ;
EN ;
+1 ; *** Interactive entry point
+2 NEW GM0CFG,GMAPPT,GMDLIM,GMHEAD,GMAUTO,GMNOTE,GMOKAY
+3 NEW GMOPUT,GMTBEG,GMTEAM,GMTEXT,GMTEND,GMXLAT
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+5 NEW X,Y,ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL
+6 NEW ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
+7 ; 0-disable/1-enable consult auto update (***DO NOT ENABLE***)
SET GMAUTO=0
+8 ;
+9 ;
+10 KILL DIR
+11 SET DIR(0)="POAr^123.033:AEMNQZ"
+12 SET DIR("A")="Select CONSULT CONFIGURATION: "
+13 SET GM0CFG=$GET(^DISV(DUZ,$$GLOBROOT^GMRCCD(123.033)))
+14 IF $$CHKCFG(+GM0CFG,1)>0
Begin DoDot:1
+15 SET DIR("B")=$$GET1^DIQ(123.033,+GM0CFG,.01)
+16 QUIT
End DoDot:1
+17 SET DIR("S")="I $$CHKCFG^GMRCCA(+Y,1)>0"
+18 WRITE !
DO ^DIR
SET GM0CFG=+$GET(Y)
+19 IF $$DIREXIT>0
GOTO EXIT
+20 ;
+21 SET GMHEAD="Select a consult date range"
+22 DO LASTMNTH^GMRCCY($$DT^XLFDT,.GMTBEG,.GMTEND)
+23 WRITE !
IF $$EN^GMRCCY(.GMTBEG,.GMTEND,GMHEAD,"U")'>0
GOTO EXIT
+24 ;
+25 KILL DIR
+26 SET DIR(0)="SOA^1:Seen in clinic;0:Not seen in clinic;"
+27 SET DIR("A",1)="Select an appointment status for the report"
+28 SET DIR("A",2)=" "
+29 SET DIR("A",3)=" 1 - Seen in clinic"
+30 SET DIR("A",4)=" 0 - Not seen in clinic"
+31 SET DIR("A",5)=" "
+32 SET DIR("A")="Select APPOINTMENT STATUS: "
+33 SET DIR("B")=1
+34 WRITE !
DO ^DIR
SET GMAPPT=+$GET(Y)
+35 IF $$DIREXIT>0
GOTO EXIT
+36 ;
+37 KILL DIR
+38 SET DIR(0)="SOA^1:Has a note;0:Does not have a note;"
+39 SET DIR("A",1)="Select a note status for the report"
+40 SET DIR("A",2)=" "
+41 SET DIR("A",3)=" 1 - Has a note"
+42 SET DIR("A",4)=" 0 - Does not have a note"
+43 SET DIR("A",5)=" "
+44 SET DIR("A")="Select NOTE STATUS: "
+45 SET DIR("B")=1
+46 WRITE !
DO ^DIR
SET GMNOTE=+$GET(Y)
+47 IF $$DIREXIT>0
GOTO EXIT
+48 ;
+49 SET GMOPUT=0
SET GMXLAT=""
+50 IF GMNOTE>0
Begin DoDot:1
+51 KILL DIR
+52 SET DIR(0)="YAO"
+53 SET DIR("A")="Interactive consult update: "
+54 SET DIR("B")="Yes"
+55 WRITE !
DO ^DIR
SET GMOPUT=+$GET(Y)
+56 SET GMXLAT="1^I"
+57 IF GMOPUT>0
IF $$TEST^DDBRT'>0
Begin DoDot:2
+58 KILL GMTEXT
+59 SET GMTEXT(1)="*** The VA FileMan browser is not supported by your terminal type ***"
+60 SET GMTEXT(2)="*** You cannot use the interactive consult update on this terminal ***"
+61 SET GMTEXT="*** You may print the consult report and/or update the CPRS team ***"
+62 DO HANGMSG^GMRCCD(.GMTEXT,3,1)
+63 SET GMOPUT=0
SET GMXLAT=""
+64 QUIT
End DoDot:2
+65 QUIT
End DoDot:1
if $$DIREXIT>0
GOTO EXIT
+66 ;
+67 IF GMOPUT'>0
Begin DoDot:1
+68 SET GMTEAM=$$ISTM^GMRCCD(GM0CFG)
+69 KILL DIR
+70 SET DIR(0)="LOA^1:1:0"
+71 SET DIR("A")="Select OUTPUT TYPE: "
+72 SET DIR("A",1)="Select the output type for the report"
+73 SET DIR("A",2)=" "
+74 SET DIR("A",3)=" 1 - Print report"
+75 SET DIR("B")="1"
+76 SET GMXLAT="1^P"
+77 IF GMTEAM>0
Begin DoDot:2
+78 SET DIR(0)="LOA^1:2:0"
+79 SET DIR("A",4)=" 2 - Team update"
+80 SET DIR("B")="1,2"
+81 SET GMXLAT="12^PT"
+82 QUIT
End DoDot:2
+83 IF (GMAUTO>0)&(GMNOTE>0)
Begin DoDot:2
+84 SET DIR(0)="LOA^1:2:0"
+85 SET DIR("A",4)=" 2 - Consult update"
+86 SET DIR("B")="1,2"
+87 SET GMXLAT="12^PC"
+88 QUIT
End DoDot:2
+89 IF (GMAUTO>0)&(GMTEAM>0)&(GMNOTE>0)
Begin DoDot:2
+90 SET DIR(0)="LOA^1:3:0"
+91 SET DIR("A",4)=" 2 - Team update"
+92 SET DIR("A",5)=" 3 - Consult update"
+93 SET DIR("B")="1-3"
+94 SET GMXLAT="123^PTC"
+95 QUIT
End DoDot:2
+96 SET DIR("A",1+$ORDER(DIR("A",1E25),-1))=" "
+97 WRITE !
DO ^DIR
SET GMOPUT=$GET(Y)
+98 QUIT
End DoDot:1
if $$DIREXIT>0
GOTO EXIT
+99 SET GMOPUT=$$TRIM^XLFSTR(GMOPUT,"LR",",")
+100 SET GMOPUT=$TRANSLATE(GMOPUT,$PIECE(GMXLAT,U,1),$PIECE(GMXLAT,U,2))
+101 ;
+102 IF GMOPUT["P"
Begin DoDot:1
+103 KILL DIR
+104 SET DIR(0)="YOA"
+105 SET DIR("A")="Delimited output: "
+106 SET DIR("B")="No"
+107 WRITE !
DO ^DIR
SET GMDLIM=+$GET(Y)
+108 QUIT
End DoDot:1
if $$DIREXIT>0
GOTO EXIT
+109 IF '$TEST
Begin DoDot:1
+110 SET GMDLIM=0
+111 QUIT
End DoDot:1
+112 ;
+113 WRITE !
+114 SET ZTRTN="TASK^GMRCCA("_GMTBEG_","_GMTEND_","
+115 SET ZTRTN=ZTRTN_GM0CFG_","_GMAPPT_","_GMNOTE_","""
+116 SET ZTRTN=ZTRTN_GMOPUT_""","_GMDLIM_")"
+117 SET ZTDESC="Consult Closure Tool"
+118 IF GMOPUT["P"
Begin DoDot:1
+119 WRITE !,"This report requires a 132 column output device"
+120 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"MQ",1)
+121 QUIT
End DoDot:1
+122 IF '$TEST
Begin DoDot:1
+123 IF GMOPUT["I"
Begin DoDot:2
+124 WRITE !,"Searching for patient consults / appointments / notes",!
+125 DO WAIT^DICD
+126 DO @ZTRTN
+127 QUIT
End DoDot:2
+128 IF '$TEST
Begin DoDot:2
+129 SET ZTIO=""
+130 DO ^%ZTLOAD
+131 QUIT
End DoDot:2
+132 QUIT
End DoDot:1
+133 IF $GET(ZTSK)>0
WRITE !,"Task #",ZTSK
+134 ;
EXIT ;
+1 ; *** Common exit point
+2 QUIT
+3 ;
TASK(GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM) ;
+1 ; *** TaskMan entry point
+2 NEW GMROOT
+3 SET GMROOT=$NAME(^TMP($TEXT(+0),$JOB))
+4 KILL @GMROOT
+5 DO GETDATA^GMRCCB(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM)
+6 IF GMOPUT["C"
Begin DoDot:1
+7 DO CONSUPDT^GMRCCC(GMROOT)
+8 QUIT
End DoDot:1
+9 IF GMOPUT["T"
Begin DoDot:1
+10 DO MAKETEAM^GMRCCC(GMROOT,GM0CFG)
+11 QUIT
End DoDot:1
+12 IF GMOPUT["P"
Begin DoDot:1
+13 DO PRNTDATA^GMRCCC(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMDLIM)
+14 QUIT
End DoDot:1
+15 IF GMOPUT["I"
Begin DoDot:1
+16 DO INTERACT^GMRCCD(GMROOT)
+17 QUIT
End DoDot:1
+18 KILL @GMROOT
+19 QUIT
+20 ;
CHKCFG(GM0CFG,GMINAC) ;
+1 ; *** Screen for valid consult configuration
+2 ; GMDATA("XXX")=1 says XXX field is not populated
+3 NEW GMDATA,GMOKAY
+4 SET GMOKAY=1
+5 IF (GMINAC>0)&($$GET1^DIQ(123.033,GM0CFG,.02,"I")>0)
SET GMOKAY=0
+6 IF $$GET1^DIQ(123.033,GM0CFG,.04)'>0
SET GMOKAY=0
+7 IF $$GET1^DIQ(123.033,GM0CFG,.05)'>0
SET GMOKAY=0
+8 SET GMDATA("STOP")=($$GET1^DIQ(123.033,GM0CFG,.06,"I")'>0)
+9 FOR GMDATA="CLIN","CLPR","CONP","CONS","NOTE","PROT"
Begin DoDot:1
+10 SET GMDATA(GMDATA)=($ORDER(^GMR(123.033,GM0CFG,GMDATA,0))'>0)
+11 QUIT
End DoDot:1
+12 IF (GMDATA("CLPR"))&(GMDATA("CONP"))&(GMDATA("CONS"))&(GMDATA("PROT"))
SET GMOKAY=0
+13 IF (GMDATA("CLIN"))&(GMDATA("STOP"))
SET GMOKAY=0
+14 IF GMDATA("NOTE")
SET GMOKAY=0
+15 QUIT GMOKAY
+16 ;
DIREXIT() ;
+1 ; *** DIR exit status
+2 QUIT $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
+3 ;
POSTSAVE(GM0CFG) ;
+1 ; *** Post-save code for config editor
+2 NEW GMTEXT
+3 IF $$CHKCFG(+GM0CFG,0)'>0
Begin DoDot:1
+4 SET GMTEXT(1)="* * * The consult configuration is incomplete, required data is missing. * * *"
+5 SET GMTEXT(2)="* * * You must enter a Config Name, Days Cons->Appt, Days Appt->Note, * * *"
+6 SET GMTEXT(3)="* * * at least one type of Consult (Service, Procedure, etc.), at least * * *"
+7 SET GMTEXT(4)="* * * one Clinic and/or a Stop Code, and at least one Note Title. * * *"
+8 SET GMTEXT(5)="$$EOP"
+9 DO HLP^DDSUTL(.GMTEXT)
+10 QUIT
End DoDot:1
+11 QUIT
