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

GMRCCA.m

Go to the documentation of this file.
  1. 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
  1. ;Consult Closure Tool
  1. ; IA# Usage Component
  1. ; ---------------------------
  1. ; 4836 Private ^DIC(40.7
  1. ; 510 Controlled ^DISV(
  1. ; 1519 Supported EN^XUTMDEVQ
  1. ; 2056 Supported $$GET1^DIQ
  1. ; 2608 Supported $$TEST^DDBRT
  1. ; 10024 Supported WAIT^DICD
  1. ; 10026 Supported ^DIR
  1. ; 10063 Supported ^%ZTLOAD
  1. ; 10103 Supported $$DT^XLFDT
  1. ; 10104 Supported $$TRIM^XLFSTR
  1. ; 10150 Supported HLP^DDSUTL
  1. ;
  1. EN ;
  1. ; *** Interactive entry point
  1. N GM0CFG,GMAPPT,GMDLIM,GMHEAD,GMAUTO,GMNOTE,GMOKAY
  1. N GMOPUT,GMTBEG,GMTEAM,GMTEXT,GMTEND,GMXLAT
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. N X,Y,ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL
  1. N ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
  1. S GMAUTO=0 ; 0-disable/1-enable consult auto update (***DO NOT ENABLE***)
  1. ;
  1. ;
  1. K DIR
  1. S DIR(0)="POAr^123.033:AEMNQZ"
  1. S DIR("A")="Select CONSULT CONFIGURATION: "
  1. S GM0CFG=$G(^DISV(DUZ,$$GLOBROOT^GMRCCD(123.033)))
  1. I $$CHKCFG(+GM0CFG,1)>0 D
  1. . S DIR("B")=$$GET1^DIQ(123.033,+GM0CFG,.01)
  1. . Q
  1. S DIR("S")="I $$CHKCFG^GMRCCA(+Y,1)>0"
  1. W ! D ^DIR S GM0CFG=+$G(Y)
  1. I $$DIREXIT>0 G EXIT
  1. ;
  1. S GMHEAD="Select a consult date range"
  1. D LASTMNTH^GMRCCY($$DT^XLFDT,.GMTBEG,.GMTEND)
  1. W ! I $$EN^GMRCCY(.GMTBEG,.GMTEND,GMHEAD,"U")'>0 G EXIT
  1. ;
  1. K DIR
  1. S DIR(0)="SOA^1:Seen in clinic;0:Not seen in clinic;"
  1. S DIR("A",1)="Select an appointment status for the report"
  1. S DIR("A",2)=" "
  1. S DIR("A",3)=" 1 - Seen in clinic"
  1. S DIR("A",4)=" 0 - Not seen in clinic"
  1. S DIR("A",5)=" "
  1. S DIR("A")="Select APPOINTMENT STATUS: "
  1. S DIR("B")=1
  1. W ! D ^DIR S GMAPPT=+$G(Y)
  1. I $$DIREXIT>0 G EXIT
  1. ;
  1. K DIR
  1. S DIR(0)="SOA^1:Has a note;0:Does not have a note;"
  1. S DIR("A",1)="Select a note status for the report"
  1. S DIR("A",2)=" "
  1. S DIR("A",3)=" 1 - Has a note"
  1. S DIR("A",4)=" 0 - Does not have a note"
  1. S DIR("A",5)=" "
  1. S DIR("A")="Select NOTE STATUS: "
  1. S DIR("B")=1
  1. W ! D ^DIR S GMNOTE=+$G(Y)
  1. I $$DIREXIT>0 G EXIT
  1. ;
  1. S GMOPUT=0,GMXLAT=""
  1. I GMNOTE>0 D G:$$DIREXIT>0 EXIT
  1. . K DIR
  1. . S DIR(0)="YAO"
  1. . S DIR("A")="Interactive consult update: "
  1. . S DIR("B")="Yes"
  1. . W ! D ^DIR S GMOPUT=+$G(Y)
  1. . S GMXLAT="1^I"
  1. . I GMOPUT>0 I $$TEST^DDBRT'>0 D
  1. .. K GMTEXT
  1. .. S GMTEXT(1)="*** The VA FileMan browser is not supported by your terminal type ***"
  1. .. S GMTEXT(2)="*** You cannot use the interactive consult update on this terminal ***"
  1. .. S GMTEXT="*** You may print the consult report and/or update the CPRS team ***"
  1. .. D HANGMSG^GMRCCD(.GMTEXT,3,1)
  1. .. S GMOPUT=0,GMXLAT=""
  1. .. Q
  1. . Q
  1. ;
  1. I GMOPUT'>0 D G:$$DIREXIT>0 EXIT
  1. . S GMTEAM=$$ISTM^GMRCCD(GM0CFG)
  1. . K DIR
  1. . S DIR(0)="LOA^1:1:0"
  1. . S DIR("A")="Select OUTPUT TYPE: "
  1. . S DIR("A",1)="Select the output type for the report"
  1. . S DIR("A",2)=" "
  1. . S DIR("A",3)=" 1 - Print report"
  1. . S DIR("B")="1"
  1. . S GMXLAT="1^P"
  1. . I GMTEAM>0 D
  1. .. S DIR(0)="LOA^1:2:0"
  1. .. S DIR("A",4)=" 2 - Team update"
  1. .. S DIR("B")="1,2"
  1. .. S GMXLAT="12^PT"
  1. .. Q
  1. . I (GMAUTO>0)&(GMNOTE>0) D
  1. .. S DIR(0)="LOA^1:2:0"
  1. .. S DIR("A",4)=" 2 - Consult update"
  1. .. S DIR("B")="1,2"
  1. .. S GMXLAT="12^PC"
  1. .. Q
  1. . I (GMAUTO>0)&(GMTEAM>0)&(GMNOTE>0) D
  1. .. S DIR(0)="LOA^1:3:0"
  1. .. S DIR("A",4)=" 2 - Team update"
  1. .. S DIR("A",5)=" 3 - Consult update"
  1. .. S DIR("B")="1-3"
  1. .. S GMXLAT="123^PTC"
  1. .. Q
  1. . S DIR("A",1+$O(DIR("A",1E25),-1))=" "
  1. . W ! D ^DIR S GMOPUT=$G(Y)
  1. . Q
  1. S GMOPUT=$$TRIM^XLFSTR(GMOPUT,"LR",",")
  1. S GMOPUT=$TR(GMOPUT,$P(GMXLAT,U,1),$P(GMXLAT,U,2))
  1. ;
  1. I GMOPUT["P" D G:$$DIREXIT>0 EXIT
  1. . K DIR
  1. . S DIR(0)="YOA"
  1. . S DIR("A")="Delimited output: "
  1. . S DIR("B")="No"
  1. . W ! D ^DIR S GMDLIM=+$G(Y)
  1. . Q
  1. E D
  1. . S GMDLIM=0
  1. . Q
  1. ;
  1. W !
  1. S ZTRTN="TASK^GMRCCA("_GMTBEG_","_GMTEND_","
  1. S ZTRTN=ZTRTN_GM0CFG_","_GMAPPT_","_GMNOTE_","""
  1. S ZTRTN=ZTRTN_GMOPUT_""","_GMDLIM_")"
  1. S ZTDESC="Consult Closure Tool"
  1. I GMOPUT["P" D
  1. . W !,"This report requires a 132 column output device"
  1. . D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"MQ",1)
  1. . Q
  1. E D
  1. . I GMOPUT["I" D
  1. .. W !,"Searching for patient consults / appointments / notes",!
  1. .. D WAIT^DICD
  1. .. D @ZTRTN
  1. .. Q
  1. . E D
  1. .. S ZTIO=""
  1. .. D ^%ZTLOAD
  1. .. Q
  1. . Q
  1. I $G(ZTSK)>0 W !,"Task #",ZTSK
  1. ;
  1. EXIT ;
  1. ; *** Common exit point
  1. Q
  1. ;
  1. TASK(GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM) ;
  1. ; *** TaskMan entry point
  1. N GMROOT
  1. S GMROOT=$NA(^TMP($T(+0),$J))
  1. K @GMROOT
  1. D GETDATA^GMRCCB(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM)
  1. I GMOPUT["C" D
  1. . D CONSUPDT^GMRCCC(GMROOT)
  1. . Q
  1. I GMOPUT["T" D
  1. . D MAKETEAM^GMRCCC(GMROOT,GM0CFG)
  1. . Q
  1. I GMOPUT["P" D
  1. . D PRNTDATA^GMRCCC(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMDLIM)
  1. . Q
  1. I GMOPUT["I" D
  1. . D INTERACT^GMRCCD(GMROOT)
  1. . Q
  1. K @GMROOT
  1. Q
  1. ;
  1. CHKCFG(GM0CFG,GMINAC) ;
  1. ; *** Screen for valid consult configuration
  1. ; GMDATA("XXX")=1 says XXX field is not populated
  1. N GMDATA,GMOKAY
  1. S GMOKAY=1
  1. I (GMINAC>0)&($$GET1^DIQ(123.033,GM0CFG,.02,"I")>0) S GMOKAY=0
  1. I $$GET1^DIQ(123.033,GM0CFG,.04)'>0 S GMOKAY=0
  1. I $$GET1^DIQ(123.033,GM0CFG,.05)'>0 S GMOKAY=0
  1. S GMDATA("STOP")=($$GET1^DIQ(123.033,GM0CFG,.06,"I")'>0)
  1. F GMDATA="CLIN","CLPR","CONP","CONS","NOTE","PROT" D
  1. . S GMDATA(GMDATA)=($O(^GMR(123.033,GM0CFG,GMDATA,0))'>0)
  1. . Q
  1. I (GMDATA("CLPR"))&(GMDATA("CONP"))&(GMDATA("CONS"))&(GMDATA("PROT")) S GMOKAY=0
  1. I (GMDATA("CLIN"))&(GMDATA("STOP")) S GMOKAY=0
  1. I GMDATA("NOTE") S GMOKAY=0
  1. Q GMOKAY
  1. ;
  1. DIREXIT() ;
  1. ; *** DIR exit status
  1. Q $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)
  1. ;
  1. POSTSAVE(GM0CFG) ;
  1. ; *** Post-save code for config editor
  1. N GMTEXT
  1. I $$CHKCFG(+GM0CFG,0)'>0 D
  1. . S GMTEXT(1)="* * * The consult configuration is incomplete, required data is missing. * * *"
  1. . S GMTEXT(2)="* * * You must enter a Config Name, Days Cons->Appt, Days Appt->Note, * * *"
  1. . S GMTEXT(3)="* * * at least one type of Consult (Service, Procedure, etc.), at least * * *"
  1. . S GMTEXT(4)="* * * one Clinic and/or a Stop Code, and at least one Note Title. * * *"
  1. . S GMTEXT(5)="$$EOP"
  1. . D HLP^DDSUTL(.GMTEXT)
  1. . Q
  1. Q