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

GMRCCC.m

Go to the documentation of this file.
  1. GMRCCC ;SFVAMC/DAD - Consult Closure Tool: Output Data ;01/20/17 15:19
  1. ;;3.0;CONSULT/REQUEST TRACKING;**89**;DEC 27, 1997;Build 62
  1. ;Consult Closure Tool
  1. ;
  1. ; IA# Usage Component
  1. ; ---------------------------
  1. ; 2699 Private ^TIU(8925,D0,0
  1. ; 3005 Controlled ^OR(100.21
  1. ; 2051 Supported $$FIND1^DIC
  1. ; 2051 Supported LIST^DIC
  1. ; 2053 Supported UPDATE^DIE
  1. ; 2054 Supported CLEAN^DILF
  1. ; 2056 Supported $$GET1^DIQ
  1. ; 2980 Controlled $$SFILE^GMRCGUIB
  1. ; 3473 Private GET^GMRCTIU
  1. ; 10026 Supported ^DIR
  1. ; 10081 Supported SETUP^XQALERT
  1. ; 10089 Supported ^%ZISC
  1. ; 10103 Supported $$DT^XLFDT
  1. ; 10103 Supported $$FMTE^XLFDT
  1. ; 10103 Supported $$NOW^XLFDT
  1. ;
  1. PRNTDATA(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMDLIM) ;
  1. ; *** Print the data
  1. N GMCLIN,GMCONS,GMEXIT,GMNAME,GMPAGE,GMTITL
  1. U IO
  1. S (GMEXIT,GMPAGE)=0
  1. D HEADER(.GMPAGE,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMDLIM)
  1. S GMCONS=""
  1. I $O(@GMROOT@("DATA",GMCONS))="" D
  1. . D WRITE("!!","*** No data found ***",21,GMDLIM)
  1. . Q
  1. F S GMCONS=$O(@GMROOT@("DATA",GMCONS)) Q:GMCONS=""!GMEXIT D
  1. . S GMCLIN=""
  1. . F S GMCLIN=$O(@GMROOT@("DATA",GMCONS,GMCLIN)) Q:GMCLIN=""!GMEXIT D
  1. .. S GMNAME=""
  1. .. F S GMNAME=$O(@GMROOT@("DATA",GMCONS,GMCLIN,GMNAME)) Q:GMNAME=""!GMEXIT D
  1. ... S GMTITL=""
  1. ... F S GMTITL=$O(@GMROOT@("DATA",GMCONS,GMCLIN,GMNAME,GMTITL)) Q:GMTITL=""!GMEXIT D
  1. .... D PRINT(GMROOT,GMCONS,GMCLIN,GMTITL,GMNAME,GMDLIM)
  1. .... D PAUSE(.GMEXIT,.GMPAGE,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMDLIM)
  1. .... Q
  1. ... Q
  1. .. Q
  1. . Q
  1. D ^%ZISC
  1. Q
  1. ;
  1. PRINT(GMROOT,GMCONS,GMCLIN,GMTITL,GMNAME,GMDLIM) ;
  1. ; *** Print one record
  1. ; Array("DATA", Consult^IEN, Clinic^IEN, Note^IEN, Patient^IEN) =
  1. ; SSN ^ ConsultDate ^ ApptDate ^ ApptStatusInt ^ ApptStatusExt ^ NoteDate
  1. N GMDATA
  1. S GMDATA=$G(@GMROOT@("DATA",GMCONS,GMCLIN,GMNAME,GMTITL))
  1. D WRITE("!!",$P(GMNAME,U,1),30,GMDLIM) ; Pt Name
  1. D WRITE("?34",$P(GMDATA,U,1),10,GMDLIM) ; SSN
  1. D WRITE("?48",$P(GMCONS,U,1),63,GMDLIM) ; Consult Title
  1. D WRITE("?115",$$DATE($P(GMDATA,U,2),"2MZ"),14,GMDLIM) ; Consult Date
  1. D WRITE("!",$P(GMCLIN,U,1),30,GMDLIM) ; Appt Clinic
  1. D WRITE("?34",$$DATE($P(GMDATA,U,3),"2MZ"),14,GMDLIM) ; Appt Date
  1. D WRITE("?65",$P(GMDATA,U,5),33,GMDLIM) ; Appt Status
  1. D WRITE("!",$P(GMTITL,U,1),60,GMDLIM) ; Note Title
  1. D WRITE("?65",$$DATE($P(GMDATA,U,6),"2MZ"),14,GMDLIM) ; Note Date
  1. D WRITE("?115",$$BOOL($P(GMDATA,U,9)),3,GMDLIM) ; Consult Updated
  1. W:GMDLIM>0 !
  1. Q
  1. ;
  1. DATE(GMDATE,GMFORM) ;
  1. ; *** Format dates
  1. Q $S(GMDATE>0:$$FMTE^XLFDT(GMDATE,GMFORM),1:"")
  1. ;
  1. BOOL(GMBOOL) ;
  1. ; *** Format boolean
  1. Q $S(''GMBOOL:"Yes",1:"No")
  1. ;
  1. PAUSE(GMEXIT,GMPAGE,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMDLIM) ;
  1. ; *** Pause at end of page
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. I (GMDLIM'>0)&($Y>(IOSL-5)) D
  1. . I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR S GMEXIT='$G(Y)
  1. . I GMEXIT'>0 D HEADER(.GMPAGE,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMDLIM)
  1. . Q
  1. Q
  1. ;
  1. ; *** Page header
  1. S GMPAGE=GMPAGE+1
  1. I (GMDLIM'>0)&(($E(IOST,1,2)="C-")!(GMPAGE>1)) W @IOF
  1. D CENTER("Consult Closure Tool",GMDLIM)
  1. I GMDLIM'>0 D WRITE("?115",$$DATE($$DT^XLFDT,"2DZ"),8,GMDLIM)
  1. D CENTER("Consults from "_$$DATE(GMTBEG,"2DZ")_" to "_$$DATE(GMTEND,"2DZ"),GMDLIM)
  1. I GMDLIM'>0 D WRITE("?115","Page: "_GMPAGE,9,GMDLIM)
  1. D CENTER("Consult configuration: "_$$GET1^DIQ(123.033,GM0CFG,.01),GMDLIM)
  1. D CENTER("Appointment status: "_$S(GMAPPT>0:"Seen",1:"Not seen")_" in clinic",GMDLIM)
  1. D CENTER("Note status: "_$S(GMNOTE>0:"Has",1:"Does not have")_" a note",GMDLIM)
  1. D WRITE("!!","Patient Name",12,GMDLIM)
  1. D WRITE("?34","SSN",3,GMDLIM)
  1. D WRITE("?48","Consult Title",13,GMDLIM)
  1. D WRITE("?115","Consult Date",12,GMDLIM)
  1. D WRITE("!","Appt Clinic",11,GMDLIM)
  1. D WRITE("?34","Appt Date",9,GMDLIM)
  1. D WRITE("?65","Appt Status",11,GMDLIM)
  1. D WRITE("!","Note Title",10,GMDLIM)
  1. D WRITE("?65","Note Date",9,GMDLIM)
  1. D WRITE("?115","Consult Updated",15,GMDLIM)
  1. I GMDLIM'>0 D WRITE("!",$TR($J("",IOM)," ","-"),IOM,GMDLIM)
  1. W:GMDLIM>0 !
  1. Q
  1. ;
  1. WRITE(GMFMT,GMDATA,GMLEN,GMDLIM) ;
  1. ; *** Output the data
  1. W:(GMDLIM'>0)&(GMLEN>0) @GMFMT
  1. W $S(GMDLIM'>0:$E(GMDATA,1,GMLEN),1:GMDATA)
  1. W:GMDLIM>0 U
  1. Q
  1. ;
  1. CENTER(GMDATA,GMDLIM) ;
  1. ; *** Center data
  1. D WRITE("!?"_(IOM-$L(GMDATA)\2),GMDATA,$L(GMDATA),GMDLIM)
  1. W:GMDLIM>0 !
  1. Q
  1. ;
  1. MAKETEAM(GMROOT,GM0CFG) ;
  1. ; *** Update the CPRS team
  1. N GM0DFN,GM0TM,GM1TM,GMDPT,GMIENS,GMINDX,GMLIST
  1. ; Is there a team associated with the selected configuration?
  1. I $$ISTM^GMRCCD(GM0CFG)>0 D
  1. . S GM0TM=$$GET1^DIQ(123.033,GM0CFG,.03,"I")
  1. . S GMLIST=$NA(^TMP("DILIST",$J))
  1. . K @GMLIST,@GMROOT@("TEAM-FDA")
  1. . S GMDPT=$$GLOBROOT^GMRCCD(2,";")
  1. . ; Get current list of patients in team
  1. . D LIST^DIC(100.2101,","_GM0TM_",")
  1. . D CLEAN^DILF
  1. . S GMINDX=0
  1. . ; Make FDA array to delete current patients from team
  1. . F S GMINDX=$O(@GMLIST@(2,GMINDX)) Q:GMINDX'>0 D
  1. .. S GM1TM=$G(@GMLIST@(2,GMINDX))
  1. .. S GMIENS=GM1TM_","_GM0TM_","
  1. .. I GM1TM>0 S @GMROOT@("TEAM-FDA",100.2101,GMIENS,.01)="@"
  1. .. Q
  1. . K @GMLIST
  1. . ; Delete current patients from team
  1. . I $D(@GMROOT@("TEAM-FDA")) D
  1. .. D UPDATE^DIE("",$NA(@GMROOT@("TEAM-FDA")))
  1. .. D CLEAN^DILF
  1. .. Q
  1. . K @GMROOT@("TEAM-FDA")
  1. . S GM0DFN=0
  1. . ; Make FDA array to add new patients to team
  1. . F S GM0DFN=$O(@GMROOT@("XREF-DFN",GM0DFN)) Q:GM0DFN'>0 D
  1. .. S GMIENS="+"_GM0DFN_","_GM0TM_","
  1. .. S @GMROOT@("TEAM-FDA",100.2101,GMIENS,.01)=GM0DFN_GMDPT
  1. .. Q
  1. . ; Add new patients to team
  1. . I $D(@GMROOT@("TEAM-FDA")) D
  1. .. D UPDATE^DIE("",$NA(@GMROOT@("TEAM-FDA")))
  1. .. D CLEAN^DILF
  1. .. Q
  1. . K @GMROOT@("TEAM-FDA")
  1. . D TEAMALRT(GM0CFG)
  1. . Q
  1. Q
  1. ;
  1. TEAMALRT(GM0CFG) ;
  1. ; *** Alert users when team is updated
  1. N GM0DUZ,GM0TM,GMINDX,GMLIST,XQA,XQAARCH,XQADATA
  1. N XQAFLG,XQAID,XQAMSG,XQAOPT,XQAROU,XQASUPV,XQASURO
  1. S GM0TM=$$GET1^DIQ(123.033,GM0CFG,.03,"I")
  1. S GMLIST=$NA(^TMP("DILIST",$J))
  1. K @GMLIST
  1. D LIST^DIC(100.212,","_GM0TM_",")
  1. D CLEAN^DILF
  1. S GMINDX=0
  1. F S GMINDX=$O(@GMLIST@(2,GMINDX)) Q:GMINDX'>0 D
  1. . S GM0DUZ=$G(@GMLIST@(2,GMINDX))
  1. . I GM0DUZ>0 S XQA(GM0DUZ)=""
  1. . Q
  1. K @GMLIST
  1. S GM0DUZ=$$GET1^DIQ(100.21,GM0TM,1.6,"I")
  1. I GM0DUZ>0 S XQA(GM0DUZ)=""
  1. S XQA(DUZ)=""
  1. S XQAMSG="Consult Closure Tool has updated '"
  1. S XQAMSG=XQAMSG_$$GET1^DIQ(123.033,GM0CFG,.03)_"' team"
  1. S XQAID=$T(+0)_";"_DUZ_";"_$$NOW^XLFDT
  1. D SETUP^XQALERT
  1. Q
  1. ;
  1. CONSUPDT(GMROOT) ;
  1. ; *** Update the consults non-interactively
  1. N GM0CON,GM0NOT,GMCLIN,GMCONS,GMDATA
  1. N GMMSG,GMNAME,GMTITL,GMUPDT
  1. S GMCONS=""
  1. F S GMCONS=$O(@GMROOT@("DATA",GMCONS)) Q:GMCONS="" D
  1. . S GMCLIN=""
  1. . F S GMCLIN=$O(@GMROOT@("DATA",GMCONS,GMCLIN)) Q:GMCLIN="" D
  1. .. S GMTITL=""
  1. .. F S GMTITL=$O(@GMROOT@("DATA",GMCONS,GMCLIN,GMTITL)) Q:GMTITL="" D
  1. ... S GMNAME=""
  1. ... F S GMNAME=$O(@GMROOT@("DATA",GMCONS,GMCLIN,GMTITL,GMNAME)) Q:GMNAME="" D
  1. .... S GMDATA=$G(@GMROOT@("DATA",GMCONS,GMCLIN,GMTITL,GMNAME))
  1. .... S GM0CON=$P(GMDATA,U,7)
  1. .... S GM0NOT=$P(GMDATA,U,8)
  1. .... I (GM0CON>0)&(GM0NOT>0) D
  1. ..... S GMUPDT=$$CONUPDT(GM0CON,GM0NOT,.GMMSG)
  1. ..... S $P(GMDATA,U,9,10)=GMUPDT_U_$G(GMMSG)
  1. ..... S @GMROOT@("DATA",GMCONS,GMCLIN,GMTITL,GMNAME)=GMDATA
  1. ..... Q
  1. .... Q
  1. ... Q
  1. .. Q
  1. . Q
  1. Q
  1. ;
  1. CONUPDT(GM0CON,GM0NOT,GMMSG) ;
  1. ; *** Update a consult
  1. N GMALRT,GMAUTH,GMDUZ,GMFIND,GMNOW
  1. N GMOKAY,GMSTAT,GMTO,GMRCADUZ K GMMSG
  1. ; Get note status, compute consult status
  1. D NOTESTAT^GMRCCD(.GMSTAT)
  1. S GMAUTH=$$GET1^DIQ(8925,GM0NOT,1202,"I")
  1. S GMSTAT=$$GET1^DIQ(8925,GM0NOT,.05,"I")
  1. I $D(GMSTAT(+GMSTAT))#2>0 S GMSTAT="COMPLETED"
  1. E S GMSTAT="INCOMPLETE"
  1. ; Update a consult with a TIU note
  1. D GET^GMRCTIU(GM0CON,GM0NOT,GMSTAT,GMAUTH)
  1. ; Get recipients of consult notification
  1. D EN^GMRCT($$GET1^DIQ(123,GM0CON,1,"I"))
  1. S (GMTO,GMDUZ)=""
  1. F S GMDUZ=$O(GMRCADUZ(GMDUZ)) Q:GMDUZ'>0 D
  1. . S GMTO=GMTO_GMDUZ_$S($O(GMRCADUZ(GMDUZ))>0:";",1:"")
  1. . Q
  1. S GMALRT=$S(GMSTAT="COMPLETED":0,1:1)
  1. S GMFIND="U"
  1. S GMNOW=$$NOW^XLFDT
  1. S GMMSG(1)="Administrative closure performed"
  1. S GMMSG(2)="by the Consult Closure Tool."
  1. S GMSTAT=$$FIND1^DIC(123.1,"","X","COMPLETE/UPDATE","B")
  1. ; Administrative completion of a consult
  1. S GMOKAY=$$SFILE^GMRCGUIB(GM0CON,GMSTAT,GMFIND,GMAUTH,DUZ,.GMMSG,GMALRT,GMTO,GMNOW)
  1. K GMMSG S GMMSG=$P(GMOKAY,U,2)
  1. Q '$P(GMOKAY,U,1)