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

GMRCCD.m

Go to the documentation of this file.
  1. 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
  1. ;Consult Closure Tool
  1. ;
  1. ; IA# Usage Component
  1. ; ---------------------------
  1. ; 4836 Private $$GET1^DIQ(123.033,GM0CFG,.06,"I")
  1. ; 3005 Controlled $$GET1^DIQ(123.033,GM0CFG,".03:1","I")
  1. ; 10040 Supported $$GET1^DIQ(123.033,GM0CFG,.06
  1. ; 4072 Controlled $$FIND1^DIC(8925.6
  1. ; 2051 Supported $$FIND1^DIC
  1. ; 2051 Supported LIST^DIC
  1. ; 2052 Supported $$GET1^DID
  1. ; 2054 Supported CLEAN^DILF
  1. ; 2056 Supported $$GET1^DIQ
  1. ; 2607 Supported DOCLIST^DDBR
  1. ; 2832 Controlled RPC^TIUSRV
  1. ; 2925 Controlled DT^GMRCSLM2
  1. ; 10026 Supported ^DIR
  1. ; 10086 Supported HOME^%ZIS
  1. ; 10096 Supported ^%ZOSF(
  1. ;
  1. INTERACT(GMROOT) ;
  1. ; *** Interactive consult update
  1. N GM0CON,GM0NOT,GMCCNT,GMCONS,GMCRPT,GMDOCS
  1. N GMEXIT,GMINDX,GMNAME,GMNCNT,GMNOTE,GMNRPT
  1. N GMNTXT,GMPCNT,GMTEXT,GMTITL,GMRCOER,GMRCQUT
  1. D HOME^%ZIS
  1. S GMDOCS=$NA(@GMROOT@("DOCS-LIST"))
  1. S GMNRPT=$NA(@GMROOT@("NOTE-TEXT"))
  1. S GMCRPT=$NA(^TMP("GMRCR",$J,"DT"))
  1. S GMNOTE=$NA(^TMP("TIUAUDIT",$J))
  1. D COUNT(GMROOT,.GMPCNT,.GMCCNT,.GMNCNT)
  1. S GMPCNT(0)=GMPCNT
  1. S GMCCNT(0)=GMCCNT
  1. S GMNCNT(0)=GMNCNT
  1. K GMTEXT
  1. S GMTEXT(1)="The Consult Closure Tool has identified"
  1. S GMTEXT(2)=" Patients: "_$J(GMPCNT,4)
  1. S GMTEXT(3)=" Consults: "_$J(GMCCNT,4)
  1. S GMTEXT(4)=" Notes: "_$J(GMNCNT,4)
  1. S GMTEXT(5)="that meet your selected criteria."
  1. S GMTEXT(6)=""
  1. S GMTEXT="Enter RETURN to continue: "
  1. D HANGMSG(.GMTEXT,$G(DTIME,900),1)
  1. S GMNAME="",(GMEXIT,GMPCNT,GMCCNT,GMNCNT)=0
  1. I $O(@GMROOT@("DATA",GMNAME))="" D
  1. . K GMTEXT S GMTEXT="*** No data found ***"
  1. . D HANGMSG(.GMTEXT,0,1)
  1. . Q
  1. F S GMNAME=$O(@GMROOT@("DATA",GMNAME)) Q:(GMNAME="")!(GMEXIT>0) D
  1. . S GMPCNT=GMPCNT+1
  1. . S GMCONS=""
  1. . F S GMCONS=$O(@GMROOT@("DATA",GMNAME,GMCONS)) Q:(GMCONS="")!(GMEXIT>0) D
  1. .. S GMCCNT=GMCCNT+1
  1. .. K @GMCRPT,@GMDOCS,@GMNRPT
  1. .. ; Get consult text
  1. .. S GM0CON=$P(GMCONS,U,2)
  1. .. S GMRCOER=2
  1. .. K GMRCQUT
  1. .. D DT^GMRCSLM2(GM0CON)
  1. .. I $G(GMRCQUT)'>0 D
  1. ... S GMTITL="",GMINDX=0
  1. ... F S GMTITL=$O(@GMROOT@("DATA",GMNAME,GMCONS,GMTITL)) Q:(GMTITL="")!(GMEXIT>0) D
  1. .... S GMNCNT=GMNCNT+1
  1. .... S GM0NOT=$P(GMTITL,U,3)
  1. .... ; Build browser doc list
  1. .... I (GM0CON>0)&(GM0NOT>0) D
  1. ..... S GMINDX=GMINDX+1
  1. ..... ; Add consult to doc list
  1. ..... S GMTEXT="Consult Narrative"
  1. ..... S GMTEXT=GMTEXT_" ("_GMCCNT_" of "_GMCCNT(0)_")"
  1. ..... S @GMDOCS@(GMTEXT)=GMCRPT
  1. ..... ; Get progress note text
  1. ..... K @GMNOTE
  1. ..... D RPC^TIUSRV(.GMNOTE,GM0NOT)
  1. ..... S GMNTXT=$NA(@GMNRPT@(GM0NOT))
  1. ..... M @GMNTXT=@GMNOTE
  1. ..... K @GMNOTE
  1. ..... ; Add progress note to doc list
  1. ..... S GMTEXT="Note "_$TR($J(GMINDX,2)," ","0")
  1. ..... S GMTEXT=GMTEXT_": "_$P(GMTITL,U,1)
  1. ..... S @GMDOCS@(GMTEXT)=GMNTXT
  1. ..... Q
  1. .... Q
  1. ... D SHOWPICK(GMDOCS,GM0CON,.GMEXIT)
  1. ... Q
  1. .. K @GMCRPT,@GMDOCS,@GMNRPT
  1. .. Q
  1. . Q
  1. I GMEXIT'>0 D
  1. . K GMTEXT S GMTEXT="*** Done ***"
  1. . D HANGMSG(.GMTEXT,0,0)
  1. . Q
  1. Q
  1. ;
  1. SHOWPICK(GMROOT,GM0CON,GMEXIT) ;
  1. ; *** Show consult & progress notes
  1. ; *** Pick progress note to close consult
  1. I $O(@GMROOT@(""))]"" F D Q:GMEXIT'="?"
  1. . D SHOWNOTE(GMROOT,GM0CON)
  1. . D PICKNOTE(GMROOT,GM0CON,.GMEXIT)
  1. . Q
  1. Q
  1. ;
  1. SHOWNOTE(GMROOT,GM0CON) ;
  1. ; *** Show consult & progress notes to user
  1. N GMLINE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. D HEADER(GM0CON,.GMLINE)
  1. D FOOTER(IOSL-2)
  1. D DOCLIST^DDBR(GMROOT,"R",GMLINE+2,IOSL-2)
  1. Q
  1. ;
  1. PICKNOTE(GMROOT,GM0CON,GMEXIT) ;
  1. ; *** Pick progress note to close consult
  1. N GM0NOT,GMBELL,GMGLOB,GMINDX,GMMAXX
  1. N GMMSGS,GMTEXT,GMTIME,GMTITL
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ; Build reader doc list
  1. S DIR("A")="Select NOTE TO CLOSE CONSULT: "
  1. S DIR("A",1)="Select the note to close the consult"
  1. S DIR("A",2)=" "
  1. S DIR("A",3)=" 0 - Do not close the consult"
  1. S GMTITL="Note 00: ",GMINDX=0
  1. F S GMTITL=$O(@GMROOT@(GMTITL)) Q:GMTITL="" D
  1. . ; The doc list data is a closed global root specifying
  1. . ; the location of the progress note text block. The last
  1. . ; subscript of data root is the IEN of the progress note.
  1. . ; @GMROOT@(DocumentTitle) = ArrayName(...,ProgressNoteIEN)
  1. . S GMGLOB=$G(@GMROOT@(GMTITL))
  1. . S GM0NOT=$QS(GMGLOB,$QL(GMGLOB))
  1. . I GM0NOT>0 D
  1. .. S GMINDX=GMINDX+1
  1. .. S DIR("A",3+GMINDX)=$J(GMINDX,3)_" - "_GMTITL
  1. .. ; IndexNumber to ProgressNoteIEN^NoteTitle mapping array
  1. .. S GM0NOT(GMINDX)=GM0NOT_U_GMTITL
  1. .. Q
  1. . Q
  1. S GMMAXX=GMINDX+1
  1. S DIR("A",3+GMINDX+1)=$J(GMMAXX,3)_" - Redisplay the consult/progress note(s)"
  1. S DIR("A",3+GMINDX+2)=" ^ - Exit the Consult Closure Tool"
  1. S DIR("A",3+GMINDX+3)=" "
  1. S DIR("B")=GMMAXX
  1. S DIR(0)="NOA^0:"_GMMAXX_":0^K:X'?1.N X"
  1. S DIR("?")="^D HEADER^GMRCCD(GM0CON)"
  1. ; Display consult closure prompt screen
  1. D HEADER(GM0CON)
  1. W ! D ^DIR S GMINDX=+$G(Y)
  1. S GMEXIT=$S($$DIREXIT^GMRCCA>0:1,GMINDX=GMMAXX:"?",1:0)
  1. K GMTEXT S GMTIME=3,GMBELL=0
  1. I GMEXIT=0 D
  1. . S GM0NOT=+$P($G(GM0NOT(GMINDX)),U,1)
  1. . I (GM0CON>0)&(GM0NOT>0) D
  1. .. ; Attempt to close consult
  1. .. I $$CONUPDT^GMRCCC(GM0CON,GM0NOT,.GMMSGS)>0 D
  1. ... S GMTEXT(1)="*** The consult has been closed ***"
  1. ... S GMTEXT="Selection: "_$P(GM0NOT(GMINDX),U,2)
  1. ... Q
  1. .. E D
  1. ... S GMTIME=$G(DTIME,900),GMBELL=1
  1. ... S GMTEXT(1)="*** The consult has NOT been closed ***"
  1. ... S GMTEXT(2)="Reason: "_$S($G(GMMSGS)]"":GMMSGS,1:"Unknown!")
  1. ... S GMTEXT(3)="Selection: "_$P(GM0NOT(GMINDX),U,2)
  1. ... S GMTEXT(4)=""
  1. ... S GMTEXT="Enter RETURN to continue: "
  1. ... Q
  1. .. Q
  1. . E D
  1. .. S GMTEXT="*** No action taken on the consult ***"
  1. .. Q
  1. . Q
  1. E D
  1. . I GMEXIT>0 D
  1. .. S GMTIME=0
  1. .. S GMTEXT="*** Exiting the Consult Closure Tool ***"
  1. .. Q
  1. . Q
  1. D HANGMSG(.GMTEXT,GMTIME,GMBELL)
  1. Q
  1. ;
  1. ; *** Pt name header
  1. W @IOF,"Consult closure for patient: "
  1. W $$GET1^DIQ(123,GM0CON,.02)
  1. W " (",$$GET1^DIQ(123,GM0CON,".02:.0905"),") "
  1. W $$DATE^GMRCCC($$GET1^DIQ(123,GM0CON,".02:.03","I"),"5DZ")
  1. W !,$$GET1^DIQ(123,GM0CON,1)
  1. W " (",$$GET1^DIQ(123,GM0CON,"8:.1"),") "
  1. W $$DATE^GMRCCC($$GET1^DIQ(123,GM0CON,3,"I"),"5DZ")
  1. S GMLINE=$Y
  1. Q
  1. ;
  1. ; *** Page footer instructions
  1. F Q:$Y'<(GMLINE-1) W !
  1. W !,"Use <PF1>S to Switch between views of the consult and progress note(s)"
  1. W !,"Use R to Return to the previously viewed consult or progress note(s)"
  1. Q
  1. ;
  1. HANGMSG(GMTEXT,GMTIME,GMBELL) ;
  1. ; *** Hang a message on the screen for a time
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. I $G(GMTEXT)]"" D
  1. . I $G(GMBELL)>0 S GMTEXT=GMTEXT_$C(7)
  1. . S DIR(0)="EA"
  1. . M DIR("A")=GMTEXT
  1. . S (DIR("?"),DIR("??"))=""
  1. . S DIR("T")=+$G(GMTIME)
  1. . D TYPEAHED(0)
  1. . W ! D ^DIR
  1. . D TYPEAHED(1)
  1. . Q
  1. Q
  1. ;
  1. TYPEAHED(GMBOOL) ;
  1. ; *** Enable/Disable type-ahead
  1. N GMKRNL,GMUSER
  1. I GMBOOL>0 D
  1. . S GMUSER=$TR($$GET1^DIQ(200,DUZ,200.09,"I"),"YN","10")
  1. . S GMKRNL=$TR($$GET1^DIQ(8989.3,1,209,"I"),"YN","10")
  1. . I $S(GMUSER?1N:GMUSER,1:GMKRNL)>0 X ^%ZOSF("TYPE-AHEAD")
  1. . Q
  1. E D
  1. . X ^%ZOSF("NO-TYPE-AHEAD")
  1. . Q
  1. Q
  1. ;
  1. COUNT(GMROOT,GMPCNT,GMCCNT,GMNCNT) ;
  1. ; *** Count patients / consults / notes
  1. N GMCONS,GMNAME,GMTITL,GMUCON,GMUNAM,GMUTTL
  1. S GMUNAM=$NA(@GMROOT@("UNIQUE-NAME"))
  1. S GMUCON=$NA(@GMROOT@("UNIQUE-CONS"))
  1. S GMUTTL=$NA(@GMROOT@("UNIQUE-TITL"))
  1. K @GMUNAM,@GMUCON,@GMUTTL
  1. S (GMPCNT,GMCCNT,GMNCNT)=0
  1. S GMNAME=""
  1. F S GMNAME=$O(@GMROOT@("DATA",GMNAME)) Q:GMNAME="" D
  1. . I $D(@GMUNAM@(GMNAME))#2'>0 S GMPCNT=GMPCNT+1
  1. . S @GMUNAM@(GMNAME)=""
  1. . S GMCONS=""
  1. . F S GMCONS=$O(@GMROOT@("DATA",GMNAME,GMCONS)) Q:GMCONS="" D
  1. .. I $D(@GMUCON@(GMCONS))#2'>0 S GMCCNT=GMCCNT+1
  1. .. S @GMUCON@(GMCONS)=""
  1. .. S GMTITL=""
  1. .. F S GMTITL=$O(@GMROOT@("DATA",GMNAME,GMCONS,GMTITL)) Q:GMTITL="" D
  1. ... I $D(@GMUTTL@(GMTITL))#2'>0 S GMNCNT=GMNCNT+1
  1. ... S @GMUTTL@(GMTITL)=""
  1. ... Q
  1. .. Q
  1. . Q
  1. K @GMUNAM,@GMUCON,@GMUTTL
  1. Q
  1. ;
  1. CLINLIST(GMROOT,GM0CFG) ;
  1. ; *** Get list of clinics
  1. N GM0CLN,GM0STP,GMINDX,GMLIST,GMSCRN
  1. S GM0CLN=0
  1. F S GM0CLN=$O(^GMR(123.033,GM0CFG,"CLIN","B",GM0CLN)) Q:GM0CLN'>0 D
  1. . S @GMROOT@("XREF-CLIN",GM0CLN)=""
  1. . Q
  1. S GM0STP=$$GET1^DIQ(123.033,GM0CFG,.06,"I")
  1. I GM0STP>0 D
  1. . S GMLIST=$NA(^TMP("DILIST",$J))
  1. . K @GMLIST
  1. . S GMSCRN="I $P(^(0),U,7)="_GM0STP
  1. . D LIST^DIC(44,"","@","Q","*","",GM0STP,"AST",GMSCRN)
  1. . D CLEAN^DILF
  1. . S GMINDX=0
  1. . F S GMINDX=$O(@GMLIST@(2,GMINDX)) Q:GMINDX'>0 D
  1. .. S GM0CLN=$G(@GMLIST@(2,GMINDX))
  1. .. I GM0CLN>0 S @GMROOT@("XREF-CLIN",GM0CLN)=""
  1. .. Q
  1. . K @GMLIST
  1. . Q
  1. Q
  1. ;
  1. CONSOKAY(GM0CON) ;
  1. ; *** Consult status okay?
  1. Q $S("^c^dc^x^"[(U_$$GET1^DIQ(123,GM0CON,"8:.1")_U):0,1:1)
  1. ;
  1. NOTESTAT(GMSTAT) ;
  1. ; *** Get list of note statuses
  1. N GM0STA,GMINDX
  1. K GMSTAT
  1. F GMINDX="AMENDED","COMPLETED" D
  1. . S GM0STA=$$FIND1^DIC(8925.6,"","X",GMINDX,"B")
  1. . I GM0STA>0 S GMSTAT(GM0STA)=GM0STA_U_GMINDX
  1. . Q
  1. Q
  1. ;
  1. ISTM(GM0CFG) ;
  1. ; *** Manual patient team associated with configuration?
  1. Q ($$GET1^DIQ(123.033,GM0CFG,".03:1","I")="TM")
  1. ;
  1. GLOBROOT(GMFILE,GMTRAN) ;
  1. ; *** Get file's global root
  1. N GMROOT
  1. S GMROOT=$$GET1^DID(GMFILE,"","","GLOBAL NAME")
  1. Q $S($D(GMTRAN)#2>0:$TR(GMROOT,U,GMTRAN),1:GMROOT)
  1. ;
  1. SEEN(GMSTAT) ;
  1. ; *** Pt was seen in clinic?
  1. Q ("^I^NT^R^"[(U_GMSTAT_U))
  1. ;
  1. UNSEEN(GMSTAT) ;
  1. ; *** Pt was not seen in clinic?
  1. Q ("^CC^CCR^CP^CPR^NS^NSR^"[(U_GMSTAT_U))