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