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