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