GMRCCD ;SFVAMC/DAD - Consult Closure Tool: Interactive Consult Update ;01/20/17 15:19
;;3.0;CONSULT/REQUEST TRACKING;**89**;DEC 27, 1997;Build 62
;Consult Closure Tool
;
; IA# Usage Component
; ---------------------------
; 4836 Private $$GET1^DIQ(123.033,GM0CFG,.06,"I")
; 3005 Controlled $$GET1^DIQ(123.033,GM0CFG,".03:1","I")
; 10040 Supported $$GET1^DIQ(123.033,GM0CFG,.06
; 4072 Controlled $$FIND1^DIC(8925.6
; 2051 Supported $$FIND1^DIC
; 2051 Supported LIST^DIC
; 2052 Supported $$GET1^DID
; 2054 Supported CLEAN^DILF
; 2056 Supported $$GET1^DIQ
; 2607 Supported DOCLIST^DDBR
; 2832 Controlled RPC^TIUSRV
; 2925 Controlled DT^GMRCSLM2
; 10026 Supported ^DIR
; 10086 Supported HOME^%ZIS
; 10096 Supported ^%ZOSF(
;
INTERACT(GMROOT) ;
; *** Interactive consult update
N GM0CON,GM0NOT,GMCCNT,GMCONS,GMCRPT,GMDOCS
N GMEXIT,GMINDX,GMNAME,GMNCNT,GMNOTE,GMNRPT
N GMNTXT,GMPCNT,GMTEXT,GMTITL,GMRCOER,GMRCQUT
D HOME^%ZIS
S GMDOCS=$NA(@GMROOT@("DOCS-LIST"))
S GMNRPT=$NA(@GMROOT@("NOTE-TEXT"))
S GMCRPT=$NA(^TMP("GMRCR",$J,"DT"))
S GMNOTE=$NA(^TMP("TIUAUDIT",$J))
D COUNT(GMROOT,.GMPCNT,.GMCCNT,.GMNCNT)
S GMPCNT(0)=GMPCNT
S GMCCNT(0)=GMCCNT
S GMNCNT(0)=GMNCNT
K GMTEXT
S GMTEXT(1)="The Consult Closure Tool has identified"
S GMTEXT(2)=" Patients: "_$J(GMPCNT,4)
S GMTEXT(3)=" Consults: "_$J(GMCCNT,4)
S GMTEXT(4)=" Notes: "_$J(GMNCNT,4)
S GMTEXT(5)="that meet your selected criteria."
S GMTEXT(6)=""
S GMTEXT="Enter RETURN to continue: "
D HANGMSG(.GMTEXT,$G(DTIME,900),1)
S GMNAME="",(GMEXIT,GMPCNT,GMCCNT,GMNCNT)=0
I $O(@GMROOT@("DATA",GMNAME))="" D
. K GMTEXT S GMTEXT="*** No data found ***"
. D HANGMSG(.GMTEXT,0,1)
. Q
F S GMNAME=$O(@GMROOT@("DATA",GMNAME)) Q:(GMNAME="")!(GMEXIT>0) D
. S GMPCNT=GMPCNT+1
. S GMCONS=""
. F S GMCONS=$O(@GMROOT@("DATA",GMNAME,GMCONS)) Q:(GMCONS="")!(GMEXIT>0) D
.. S GMCCNT=GMCCNT+1
.. K @GMCRPT,@GMDOCS,@GMNRPT
.. ; Get consult text
.. S GM0CON=$P(GMCONS,U,2)
.. S GMRCOER=2
.. K GMRCQUT
.. D DT^GMRCSLM2(GM0CON)
.. I $G(GMRCQUT)'>0 D
... S GMTITL="",GMINDX=0
... F S GMTITL=$O(@GMROOT@("DATA",GMNAME,GMCONS,GMTITL)) Q:(GMTITL="")!(GMEXIT>0) D
.... S GMNCNT=GMNCNT+1
.... S GM0NOT=$P(GMTITL,U,3)
.... ; Build browser doc list
.... I (GM0CON>0)&(GM0NOT>0) D
..... S GMINDX=GMINDX+1
..... ; Add consult to doc list
..... S GMTEXT="Consult Narrative"
..... S GMTEXT=GMTEXT_" ("_GMCCNT_" of "_GMCCNT(0)_")"
..... S @GMDOCS@(GMTEXT)=GMCRPT
..... ; Get progress note text
..... K @GMNOTE
..... D RPC^TIUSRV(.GMNOTE,GM0NOT)
..... S GMNTXT=$NA(@GMNRPT@(GM0NOT))
..... M @GMNTXT=@GMNOTE
..... K @GMNOTE
..... ; Add progress note to doc list
..... S GMTEXT="Note "_$TR($J(GMINDX,2)," ","0")
..... S GMTEXT=GMTEXT_": "_$P(GMTITL,U,1)
..... S @GMDOCS@(GMTEXT)=GMNTXT
..... Q
.... Q
... D SHOWPICK(GMDOCS,GM0CON,.GMEXIT)
... Q
.. K @GMCRPT,@GMDOCS,@GMNRPT
.. Q
. Q
I GMEXIT'>0 D
. K GMTEXT S GMTEXT="*** Done ***"
. D HANGMSG(.GMTEXT,0,0)
. Q
Q
;
SHOWPICK(GMROOT,GM0CON,GMEXIT) ;
; *** Show consult & progress notes
; *** Pick progress note to close consult
I $O(@GMROOT@(""))]"" F D Q:GMEXIT'="?"
. D SHOWNOTE(GMROOT,GM0CON)
. D PICKNOTE(GMROOT,GM0CON,.GMEXIT)
. Q
Q
;
SHOWNOTE(GMROOT,GM0CON) ;
; *** Show consult & progress notes to user
N GMLINE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
D HEADER(GM0CON,.GMLINE)
D FOOTER(IOSL-2)
D DOCLIST^DDBR(GMROOT,"R",GMLINE+2,IOSL-2)
Q
;
PICKNOTE(GMROOT,GM0CON,GMEXIT) ;
; *** Pick progress note to close consult
N GM0NOT,GMBELL,GMGLOB,GMINDX,GMMAXX
N GMMSGS,GMTEXT,GMTIME,GMTITL
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
; Build reader doc list
S DIR("A")="Select NOTE TO CLOSE CONSULT: "
S DIR("A",1)="Select the note to close the consult"
S DIR("A",2)=" "
S DIR("A",3)=" 0 - Do not close the consult"
S GMTITL="Note 00: ",GMINDX=0
F S GMTITL=$O(@GMROOT@(GMTITL)) Q:GMTITL="" D
. ; The doc list data is a closed global root specifying
. ; the location of the progress note text block. The last
. ; subscript of data root is the IEN of the progress note.
. ; @GMROOT@(DocumentTitle) = ArrayName(...,ProgressNoteIEN)
. S GMGLOB=$G(@GMROOT@(GMTITL))
. S GM0NOT=$QS(GMGLOB,$QL(GMGLOB))
. I GM0NOT>0 D
.. S GMINDX=GMINDX+1
.. S DIR("A",3+GMINDX)=$J(GMINDX,3)_" - "_GMTITL
.. ; IndexNumber to ProgressNoteIEN^NoteTitle mapping array
.. S GM0NOT(GMINDX)=GM0NOT_U_GMTITL
.. Q
. Q
S GMMAXX=GMINDX+1
S DIR("A",3+GMINDX+1)=$J(GMMAXX,3)_" - Redisplay the consult/progress note(s)"
S DIR("A",3+GMINDX+2)=" ^ - Exit the Consult Closure Tool"
S DIR("A",3+GMINDX+3)=" "
S DIR("B")=GMMAXX
S DIR(0)="NOA^0:"_GMMAXX_":0^K:X'?1.N X"
S DIR("?")="^D HEADER^GMRCCD(GM0CON)"
; Display consult closure prompt screen
D HEADER(GM0CON)
W ! D ^DIR S GMINDX=+$G(Y)
S GMEXIT=$S($$DIREXIT^GMRCCA>0:1,GMINDX=GMMAXX:"?",1:0)
K GMTEXT S GMTIME=3,GMBELL=0
I GMEXIT=0 D
. S GM0NOT=+$P($G(GM0NOT(GMINDX)),U,1)
. I (GM0CON>0)&(GM0NOT>0) D
.. ; Attempt to close consult
.. I $$CONUPDT^GMRCCC(GM0CON,GM0NOT,.GMMSGS)>0 D
... S GMTEXT(1)="*** The consult has been closed ***"
... S GMTEXT="Selection: "_$P(GM0NOT(GMINDX),U,2)
... Q
.. E D
... S GMTIME=$G(DTIME,900),GMBELL=1
... S GMTEXT(1)="*** The consult has NOT been closed ***"
... S GMTEXT(2)="Reason: "_$S($G(GMMSGS)]"":GMMSGS,1:"Unknown!")
... S GMTEXT(3)="Selection: "_$P(GM0NOT(GMINDX),U,2)
... S GMTEXT(4)=""
... S GMTEXT="Enter RETURN to continue: "
... Q
.. Q
. E D
.. S GMTEXT="*** No action taken on the consult ***"
.. Q
. Q
E D
. I GMEXIT>0 D
.. S GMTIME=0
.. S GMTEXT="*** Exiting the Consult Closure Tool ***"
.. Q
. Q
D HANGMSG(.GMTEXT,GMTIME,GMBELL)
Q
;
; *** Pt name header
W @IOF,"Consult closure for patient: "
W $$GET1^DIQ(123,GM0CON,.02)
W " (",$$GET1^DIQ(123,GM0CON,".02:.0905"),") "
W $$DATE^GMRCCC($$GET1^DIQ(123,GM0CON,".02:.03","I"),"5DZ")
W !,$$GET1^DIQ(123,GM0CON,1)
W " (",$$GET1^DIQ(123,GM0CON,"8:.1"),") "
W $$DATE^GMRCCC($$GET1^DIQ(123,GM0CON,3,"I"),"5DZ")
S GMLINE=$Y
Q
;
; *** Page footer instructions
F Q:$Y'<(GMLINE-1) W !
W !,"Use <PF1>S to Switch between views of the consult and progress note(s)"
W !,"Use R to Return to the previously viewed consult or progress note(s)"
Q
;
HANGMSG(GMTEXT,GMTIME,GMBELL) ;
; *** Hang a message on the screen for a time
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
I $G(GMTEXT)]"" D
. I $G(GMBELL)>0 S GMTEXT=GMTEXT_$C(7)
. S DIR(0)="EA"
. M DIR("A")=GMTEXT
. S (DIR("?"),DIR("??"))=""
. S DIR("T")=+$G(GMTIME)
. D TYPEAHED(0)
. W ! D ^DIR
. D TYPEAHED(1)
. Q
Q
;
TYPEAHED(GMBOOL) ;
; *** Enable/Disable type-ahead
N GMKRNL,GMUSER
I GMBOOL>0 D
. S GMUSER=$TR($$GET1^DIQ(200,DUZ,200.09,"I"),"YN","10")
. S GMKRNL=$TR($$GET1^DIQ(8989.3,1,209,"I"),"YN","10")
. I $S(GMUSER?1N:GMUSER,1:GMKRNL)>0 X ^%ZOSF("TYPE-AHEAD")
. Q
E D
. X ^%ZOSF("NO-TYPE-AHEAD")
. Q
Q
;
COUNT(GMROOT,GMPCNT,GMCCNT,GMNCNT) ;
; *** Count patients / consults / notes
N GMCONS,GMNAME,GMTITL,GMUCON,GMUNAM,GMUTTL
S GMUNAM=$NA(@GMROOT@("UNIQUE-NAME"))
S GMUCON=$NA(@GMROOT@("UNIQUE-CONS"))
S GMUTTL=$NA(@GMROOT@("UNIQUE-TITL"))
K @GMUNAM,@GMUCON,@GMUTTL
S (GMPCNT,GMCCNT,GMNCNT)=0
S GMNAME=""
F S GMNAME=$O(@GMROOT@("DATA",GMNAME)) Q:GMNAME="" D
. I $D(@GMUNAM@(GMNAME))#2'>0 S GMPCNT=GMPCNT+1
. S @GMUNAM@(GMNAME)=""
. S GMCONS=""
. F S GMCONS=$O(@GMROOT@("DATA",GMNAME,GMCONS)) Q:GMCONS="" D
.. I $D(@GMUCON@(GMCONS))#2'>0 S GMCCNT=GMCCNT+1
.. S @GMUCON@(GMCONS)=""
.. S GMTITL=""
.. F S GMTITL=$O(@GMROOT@("DATA",GMNAME,GMCONS,GMTITL)) Q:GMTITL="" D
... I $D(@GMUTTL@(GMTITL))#2'>0 S GMNCNT=GMNCNT+1
... S @GMUTTL@(GMTITL)=""
... Q
.. Q
. Q
K @GMUNAM,@GMUCON,@GMUTTL
Q
;
CLINLIST(GMROOT,GM0CFG) ;
; *** Get list of clinics
N GM0CLN,GM0STP,GMINDX,GMLIST,GMSCRN
S GM0CLN=0
F S GM0CLN=$O(^GMR(123.033,GM0CFG,"CLIN","B",GM0CLN)) Q:GM0CLN'>0 D
. S @GMROOT@("XREF-CLIN",GM0CLN)=""
. Q
S GM0STP=$$GET1^DIQ(123.033,GM0CFG,.06,"I")
I GM0STP>0 D
. S GMLIST=$NA(^TMP("DILIST",$J))
. K @GMLIST
. S GMSCRN="I $P(^(0),U,7)="_GM0STP
. D LIST^DIC(44,"","@","Q","*","",GM0STP,"AST",GMSCRN)
. D CLEAN^DILF
. S GMINDX=0
. F S GMINDX=$O(@GMLIST@(2,GMINDX)) Q:GMINDX'>0 D
.. S GM0CLN=$G(@GMLIST@(2,GMINDX))
.. I GM0CLN>0 S @GMROOT@("XREF-CLIN",GM0CLN)=""
.. Q
. K @GMLIST
. Q
Q
;
CONSOKAY(GM0CON) ;
; *** Consult status okay?
Q $S("^c^dc^x^"[(U_$$GET1^DIQ(123,GM0CON,"8:.1")_U):0,1:1)
;
NOTESTAT(GMSTAT) ;
; *** Get list of note statuses
N GM0STA,GMINDX
K GMSTAT
F GMINDX="AMENDED","COMPLETED" D
. S GM0STA=$$FIND1^DIC(8925.6,"","X",GMINDX,"B")
. I GM0STA>0 S GMSTAT(GM0STA)=GM0STA_U_GMINDX
. Q
Q
;
ISTM(GM0CFG) ;
; *** Manual patient team associated with configuration?
Q ($$GET1^DIQ(123.033,GM0CFG,".03:1","I")="TM")
;
GLOBROOT(GMFILE,GMTRAN) ;
; *** Get file's global root
N GMROOT
S GMROOT=$$GET1^DID(GMFILE,"","","GLOBAL NAME")
Q $S($D(GMTRAN)#2>0:$TR(GMROOT,U,GMTRAN),1:GMROOT)
;
SEEN(GMSTAT) ;
; *** Pt was seen in clinic?
Q ("^I^NT^R^"[(U_GMSTAT_U))
;
UNSEEN(GMSTAT) ;
; *** Pt was not seen in clinic?
Q ("^CC^CCR^CP^CPR^NS^NSR^"[(U_GMSTAT_U))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCCD 9450 printed Dec 13, 2024@01:45:20 Page 2
GMRCCD ;SFVAMC/DAD - Consult Closure Tool: Interactive Consult Update ;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 ; 4836 Private $$GET1^DIQ(123.033,GM0CFG,.06,"I")
+7 ; 3005 Controlled $$GET1^DIQ(123.033,GM0CFG,".03:1","I")
+8 ; 10040 Supported $$GET1^DIQ(123.033,GM0CFG,.06
+9 ; 4072 Controlled $$FIND1^DIC(8925.6
+10 ; 2051 Supported $$FIND1^DIC
+11 ; 2051 Supported LIST^DIC
+12 ; 2052 Supported $$GET1^DID
+13 ; 2054 Supported CLEAN^DILF
+14 ; 2056 Supported $$GET1^DIQ
+15 ; 2607 Supported DOCLIST^DDBR
+16 ; 2832 Controlled RPC^TIUSRV
+17 ; 2925 Controlled DT^GMRCSLM2
+18 ; 10026 Supported ^DIR
+19 ; 10086 Supported HOME^%ZIS
+20 ; 10096 Supported ^%ZOSF(
+21 ;
INTERACT(GMROOT) ;
+1 ; *** Interactive consult update
+2 NEW GM0CON,GM0NOT,GMCCNT,GMCONS,GMCRPT,GMDOCS
+3 NEW GMEXIT,GMINDX,GMNAME,GMNCNT,GMNOTE,GMNRPT
+4 NEW GMNTXT,GMPCNT,GMTEXT,GMTITL,GMRCOER,GMRCQUT
+5 DO HOME^%ZIS
+6 SET GMDOCS=$NAME(@GMROOT@("DOCS-LIST"))
+7 SET GMNRPT=$NAME(@GMROOT@("NOTE-TEXT"))
+8 SET GMCRPT=$NAME(^TMP("GMRCR",$JOB,"DT"))
+9 SET GMNOTE=$NAME(^TMP("TIUAUDIT",$JOB))
+10 DO COUNT(GMROOT,.GMPCNT,.GMCCNT,.GMNCNT)
+11 SET GMPCNT(0)=GMPCNT
+12 SET GMCCNT(0)=GMCCNT
+13 SET GMNCNT(0)=GMNCNT
+14 KILL GMTEXT
+15 SET GMTEXT(1)="The Consult Closure Tool has identified"
+16 SET GMTEXT(2)=" Patients: "_$JUSTIFY(GMPCNT,4)
+17 SET GMTEXT(3)=" Consults: "_$JUSTIFY(GMCCNT,4)
+18 SET GMTEXT(4)=" Notes: "_$JUSTIFY(GMNCNT,4)
+19 SET GMTEXT(5)="that meet your selected criteria."
+20 SET GMTEXT(6)=""
+21 SET GMTEXT="Enter RETURN to continue: "
+22 DO HANGMSG(.GMTEXT,$GET(DTIME,900),1)
+23 SET GMNAME=""
SET (GMEXIT,GMPCNT,GMCCNT,GMNCNT)=0
+24 IF $ORDER(@GMROOT@("DATA",GMNAME))=""
Begin DoDot:1
+25 KILL GMTEXT
SET GMTEXT="*** No data found ***"
+26 DO HANGMSG(.GMTEXT,0,1)
+27 QUIT
End DoDot:1
+28 FOR
SET GMNAME=$ORDER(@GMROOT@("DATA",GMNAME))
if (GMNAME="")!(GMEXIT>0)
QUIT
Begin DoDot:1
+29 SET GMPCNT=GMPCNT+1
+30 SET GMCONS=""
+31 FOR
SET GMCONS=$ORDER(@GMROOT@("DATA",GMNAME,GMCONS))
if (GMCONS="")!(GMEXIT>0)
QUIT
Begin DoDot:2
+32 SET GMCCNT=GMCCNT+1
+33 KILL @GMCRPT,@GMDOCS,@GMNRPT
+34 ; Get consult text
+35 SET GM0CON=$PIECE(GMCONS,U,2)
+36 SET GMRCOER=2
+37 KILL GMRCQUT
+38 DO DT^GMRCSLM2(GM0CON)
+39 IF $GET(GMRCQUT)'>0
Begin DoDot:3
+40 SET GMTITL=""
SET GMINDX=0
+41 FOR
SET GMTITL=$ORDER(@GMROOT@("DATA",GMNAME,GMCONS,GMTITL))
if (GMTITL="")!(GMEXIT>0)
QUIT
Begin DoDot:4
+42 SET GMNCNT=GMNCNT+1
+43 SET GM0NOT=$PIECE(GMTITL,U,3)
+44 ; Build browser doc list
+45 IF (GM0CON>0)&(GM0NOT>0)
Begin DoDot:5
+46 SET GMINDX=GMINDX+1
+47 ; Add consult to doc list
+48 SET GMTEXT="Consult Narrative"
+49 SET GMTEXT=GMTEXT_" ("_GMCCNT_" of "_GMCCNT(0)_")"
+50 SET @GMDOCS@(GMTEXT)=GMCRPT
+51 ; Get progress note text
+52 KILL @GMNOTE
+53 DO RPC^TIUSRV(.GMNOTE,GM0NOT)
+54 SET GMNTXT=$NAME(@GMNRPT@(GM0NOT))
+55 MERGE @GMNTXT=@GMNOTE
+56 KILL @GMNOTE
+57 ; Add progress note to doc list
+58 SET GMTEXT="Note "_$TRANSLATE($JUSTIFY(GMINDX,2)," ","0")
+59 SET GMTEXT=GMTEXT_": "_$PIECE(GMTITL,U,1)
+60 SET @GMDOCS@(GMTEXT)=GMNTXT
+61 QUIT
End DoDot:5
+62 QUIT
End DoDot:4
+63 DO SHOWPICK(GMDOCS,GM0CON,.GMEXIT)
+64 QUIT
End DoDot:3
+65 KILL @GMCRPT,@GMDOCS,@GMNRPT
+66 QUIT
End DoDot:2
+67 QUIT
End DoDot:1
+68 IF GMEXIT'>0
Begin DoDot:1
+69 KILL GMTEXT
SET GMTEXT="*** Done ***"
+70 DO HANGMSG(.GMTEXT,0,0)
+71 QUIT
End DoDot:1
+72 QUIT
+73 ;
SHOWPICK(GMROOT,GM0CON,GMEXIT) ;
+1 ; *** Show consult & progress notes
+2 ; *** Pick progress note to close consult
+3 IF $ORDER(@GMROOT@(""))]""
FOR
Begin DoDot:1
+4 DO SHOWNOTE(GMROOT,GM0CON)
+5 DO PICKNOTE(GMROOT,GM0CON,.GMEXIT)
+6 QUIT
End DoDot:1
if GMEXIT'="?"
QUIT
+7 QUIT
+8 ;
SHOWNOTE(GMROOT,GM0CON) ;
+1 ; *** Show consult & progress notes to user
+2 NEW GMLINE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 DO HEADER(GM0CON,.GMLINE)
+4 DO FOOTER(IOSL-2)
+5 DO DOCLIST^DDBR(GMROOT,"R",GMLINE+2,IOSL-2)
+6 QUIT
+7 ;
PICKNOTE(GMROOT,GM0CON,GMEXIT) ;
+1 ; *** Pick progress note to close consult
+2 NEW GM0NOT,GMBELL,GMGLOB,GMINDX,GMMAXX
+3 NEW GMMSGS,GMTEXT,GMTIME,GMTITL
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 ; Build reader doc list
+6 SET DIR("A")="Select NOTE TO CLOSE CONSULT: "
+7 SET DIR("A",1)="Select the note to close the consult"
+8 SET DIR("A",2)=" "
+9 SET DIR("A",3)=" 0 - Do not close the consult"
+10 SET GMTITL="Note 00: "
SET GMINDX=0
+11 FOR
SET GMTITL=$ORDER(@GMROOT@(GMTITL))
if GMTITL=""
QUIT
Begin DoDot:1
+12 ; The doc list data is a closed global root specifying
+13 ; the location of the progress note text block. The last
+14 ; subscript of data root is the IEN of the progress note.
+15 ; @GMROOT@(DocumentTitle) = ArrayName(...,ProgressNoteIEN)
+16 SET GMGLOB=$GET(@GMROOT@(GMTITL))
+17 SET GM0NOT=$QSUBSCRIPT(GMGLOB,$QLENGTH(GMGLOB))
+18 IF GM0NOT>0
Begin DoDot:2
+19 SET GMINDX=GMINDX+1
+20 SET DIR("A",3+GMINDX)=$JUSTIFY(GMINDX,3)_" - "_GMTITL
+21 ; IndexNumber to ProgressNoteIEN^NoteTitle mapping array
+22 SET GM0NOT(GMINDX)=GM0NOT_U_GMTITL
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 SET GMMAXX=GMINDX+1
+26 SET DIR("A",3+GMINDX+1)=$JUSTIFY(GMMAXX,3)_" - Redisplay the consult/progress note(s)"
+27 SET DIR("A",3+GMINDX+2)=" ^ - Exit the Consult Closure Tool"
+28 SET DIR("A",3+GMINDX+3)=" "
+29 SET DIR("B")=GMMAXX
+30 SET DIR(0)="NOA^0:"_GMMAXX_":0^K:X'?1.N X"
+31 SET DIR("?")="^D HEADER^GMRCCD(GM0CON)"
+32 ; Display consult closure prompt screen
+33 DO HEADER(GM0CON)
+34 WRITE !
DO ^DIR
SET GMINDX=+$GET(Y)
+35 SET GMEXIT=$SELECT($$DIREXIT^GMRCCA>0:1,GMINDX=GMMAXX:"?",1:0)
+36 KILL GMTEXT
SET GMTIME=3
SET GMBELL=0
+37 IF GMEXIT=0
Begin DoDot:1
+38 SET GM0NOT=+$PIECE($GET(GM0NOT(GMINDX)),U,1)
+39 IF (GM0CON>0)&(GM0NOT>0)
Begin DoDot:2
+40 ; Attempt to close consult
+41 IF $$CONUPDT^GMRCCC(GM0CON,GM0NOT,.GMMSGS)>0
Begin DoDot:3
+42 SET GMTEXT(1)="*** The consult has been closed ***"
+43 SET GMTEXT="Selection: "_$PIECE(GM0NOT(GMINDX),U,2)
+44 QUIT
End DoDot:3
+45 IF '$TEST
Begin DoDot:3
+46 SET GMTIME=$GET(DTIME,900)
SET GMBELL=1
+47 SET GMTEXT(1)="*** The consult has NOT been closed ***"
+48 SET GMTEXT(2)="Reason: "_$SELECT($GET(GMMSGS)]"":GMMSGS,1:"Unknown!")
+49 SET GMTEXT(3)="Selection: "_$PIECE(GM0NOT(GMINDX),U,2)
+50 SET GMTEXT(4)=""
+51 SET GMTEXT="Enter RETURN to continue: "
+52 QUIT
End DoDot:3
+53 QUIT
End DoDot:2
+54 IF '$TEST
Begin DoDot:2
+55 SET GMTEXT="*** No action taken on the consult ***"
+56 QUIT
End DoDot:2
+57 QUIT
End DoDot:1
+58 IF '$TEST
Begin DoDot:1
+59 IF GMEXIT>0
Begin DoDot:2
+60 SET GMTIME=0
+61 SET GMTEXT="*** Exiting the Consult Closure Tool ***"
+62 QUIT
End DoDot:2
+63 QUIT
End DoDot:1
+64 DO HANGMSG(.GMTEXT,GMTIME,GMBELL)
+65 QUIT
+66 ;
+1 ; *** Pt name header
+2 WRITE @IOF,"Consult closure for patient: "
+3 WRITE $$GET1^DIQ(123,GM0CON,.02)
+4 WRITE " (",$$GET1^DIQ(123,GM0CON,".02:.0905"),") "
+5 WRITE $$DATE^GMRCCC($$GET1^DIQ(123,GM0CON,".02:.03","I"),"5DZ")
+6 WRITE !,$$GET1^DIQ(123,GM0CON,1)
+7 WRITE " (",$$GET1^DIQ(123,GM0CON,"8:.1"),") "
+8 WRITE $$DATE^GMRCCC($$GET1^DIQ(123,GM0CON,3,"I"),"5DZ")
+9 SET GMLINE=$Y
+10 QUIT
+11 ;
+1 ; *** Page footer instructions
+2 FOR
if $Y'<(GMLINE-1)
QUIT
WRITE !
+3 WRITE !,"Use <PF1>S to Switch between views of the consult and progress note(s)"
+4 WRITE !,"Use R to Return to the previously viewed consult or progress note(s)"
+5 QUIT
+6 ;
HANGMSG(GMTEXT,GMTIME,GMBELL) ;
+1 ; *** Hang a message on the screen for a time
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 IF $GET(GMTEXT)]""
Begin DoDot:1
+4 IF $GET(GMBELL)>0
SET GMTEXT=GMTEXT_$CHAR(7)
+5 SET DIR(0)="EA"
+6 MERGE DIR("A")=GMTEXT
+7 SET (DIR("?"),DIR("??"))=""
+8 SET DIR("T")=+$GET(GMTIME)
+9 DO TYPEAHED(0)
+10 WRITE !
DO ^DIR
+11 DO TYPEAHED(1)
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
TYPEAHED(GMBOOL) ;
+1 ; *** Enable/Disable type-ahead
+2 NEW GMKRNL,GMUSER
+3 IF GMBOOL>0
Begin DoDot:1
+4 SET GMUSER=$TRANSLATE($$GET1^DIQ(200,DUZ,200.09,"I"),"YN","10")
+5 SET GMKRNL=$TRANSLATE($$GET1^DIQ(8989.3,1,209,"I"),"YN","10")
+6 IF $SELECT(GMUSER?1N:GMUSER,1:GMKRNL)>0
XECUTE ^%ZOSF("TYPE-AHEAD")
+7 QUIT
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 XECUTE ^%ZOSF("NO-TYPE-AHEAD")
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
COUNT(GMROOT,GMPCNT,GMCCNT,GMNCNT) ;
+1 ; *** Count patients / consults / notes
+2 NEW GMCONS,GMNAME,GMTITL,GMUCON,GMUNAM,GMUTTL
+3 SET GMUNAM=$NAME(@GMROOT@("UNIQUE-NAME"))
+4 SET GMUCON=$NAME(@GMROOT@("UNIQUE-CONS"))
+5 SET GMUTTL=$NAME(@GMROOT@("UNIQUE-TITL"))
+6 KILL @GMUNAM,@GMUCON,@GMUTTL
+7 SET (GMPCNT,GMCCNT,GMNCNT)=0
+8 SET GMNAME=""
+9 FOR
SET GMNAME=$ORDER(@GMROOT@("DATA",GMNAME))
if GMNAME=""
QUIT
Begin DoDot:1
+10 IF $DATA(@GMUNAM@(GMNAME))#2'>0
SET GMPCNT=GMPCNT+1
+11 SET @GMUNAM@(GMNAME)=""
+12 SET GMCONS=""
+13 FOR
SET GMCONS=$ORDER(@GMROOT@("DATA",GMNAME,GMCONS))
if GMCONS=""
QUIT
Begin DoDot:2
+14 IF $DATA(@GMUCON@(GMCONS))#2'>0
SET GMCCNT=GMCCNT+1
+15 SET @GMUCON@(GMCONS)=""
+16 SET GMTITL=""
+17 FOR
SET GMTITL=$ORDER(@GMROOT@("DATA",GMNAME,GMCONS,GMTITL))
if GMTITL=""
QUIT
Begin DoDot:3
+18 IF $DATA(@GMUTTL@(GMTITL))#2'>0
SET GMNCNT=GMNCNT+1
+19 SET @GMUTTL@(GMTITL)=""
+20 QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 KILL @GMUNAM,@GMUCON,@GMUTTL
+24 QUIT
+25 ;
CLINLIST(GMROOT,GM0CFG) ;
+1 ; *** Get list of clinics
+2 NEW GM0CLN,GM0STP,GMINDX,GMLIST,GMSCRN
+3 SET GM0CLN=0
+4 FOR
SET GM0CLN=$ORDER(^GMR(123.033,GM0CFG,"CLIN","B",GM0CLN))
if GM0CLN'>0
QUIT
Begin DoDot:1
+5 SET @GMROOT@("XREF-CLIN",GM0CLN)=""
+6 QUIT
End DoDot:1
+7 SET GM0STP=$$GET1^DIQ(123.033,GM0CFG,.06,"I")
+8 IF GM0STP>0
Begin DoDot:1
+9 SET GMLIST=$NAME(^TMP("DILIST",$JOB))
+10 KILL @GMLIST
+11 SET GMSCRN="I $P(^(0),U,7)="_GM0STP
+12 DO LIST^DIC(44,"","@","Q","*","",GM0STP,"AST",GMSCRN)
+13 DO CLEAN^DILF
+14 SET GMINDX=0
+15 FOR
SET GMINDX=$ORDER(@GMLIST@(2,GMINDX))
if GMINDX'>0
QUIT
Begin DoDot:2
+16 SET GM0CLN=$GET(@GMLIST@(2,GMINDX))
+17 IF GM0CLN>0
SET @GMROOT@("XREF-CLIN",GM0CLN)=""
+18 QUIT
End DoDot:2
+19 KILL @GMLIST
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
CONSOKAY(GM0CON) ;
+1 ; *** Consult status okay?
+2 QUIT $SELECT("^c^dc^x^"[(U_$$GET1^DIQ(123,GM0CON,"8:.1")_U):0,1:1)
+3 ;
NOTESTAT(GMSTAT) ;
+1 ; *** Get list of note statuses
+2 NEW GM0STA,GMINDX
+3 KILL GMSTAT
+4 FOR GMINDX="AMENDED","COMPLETED"
Begin DoDot:1
+5 SET GM0STA=$$FIND1^DIC(8925.6,"","X",GMINDX,"B")
+6 IF GM0STA>0
SET GMSTAT(GM0STA)=GM0STA_U_GMINDX
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
ISTM(GM0CFG) ;
+1 ; *** Manual patient team associated with configuration?
+2 QUIT ($$GET1^DIQ(123.033,GM0CFG,".03:1","I")="TM")
+3 ;
GLOBROOT(GMFILE,GMTRAN) ;
+1 ; *** Get file's global root
+2 NEW GMROOT
+3 SET GMROOT=$$GET1^DID(GMFILE,"","","GLOBAL NAME")
+4 QUIT $SELECT($DATA(GMTRAN)#2>0:$TRANSLATE(GMROOT,U,GMTRAN),1:GMROOT)
+5 ;
SEEN(GMSTAT) ;
+1 ; *** Pt was seen in clinic?
+2 QUIT ("^I^NT^R^"[(U_GMSTAT_U))
+3 ;
UNSEEN(GMSTAT) ;
+1 ; *** Pt was not seen in clinic?
+2 QUIT ("^CC^CCR^CP^CPR^NS^NSR^"[(U_GMSTAT_U))
