- 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 Feb 18, 2025@23:11:35 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