GMRCCB ;SFVAMC/DAD - Consult Closure Tool: Data Gathering ;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
; 6742 Controlled Sub ^TIU(8925,"ADCPT"
; 2054 Supported $$OREF^DILF
; 2056 Supported $$GET1^DIQ
; 4433 Supported $$SDAPI^SDAMA301
; 4837 Private ^GMR(123,"E"
; 10103 Supported $$FMADD^XLFDT
; 10103 Supported $$NOW^XLFDT
; 10105 Supported $$MIN^XLFMTH
;
GETDATA(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM) ;
; *** Get consults
N GM0CON,GM0DFN,GMCLPR,GMPROC,GMPROT,GMSERV,GMTCON
D CLINLIST^GMRCCD(GMROOT,GM0CFG)
S GMTCON=GMTBEG-.0000001
F S GMTCON=$O(^GMR(123,"E",GMTCON)) Q:(GMTCON'>0)!(GMTCON>(GMTEND+.24)) D
. S GM0CON=0
. F S GM0CON=$O(^GMR(123,"E",GMTCON,GM0CON)) Q:GM0CON'>0 D
.. I $$CONSCHEK(GM0CON,.GMSERV,.GMPROC,.GMPROT,.GMCLPR) D
... S GM0DFN=$$GET1^DIQ(123,GM0CON,.02,"I")
... I GM0DFN>0 D
.... D APPTCHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMAPPT,GMNOTE,GMOPUT)
.... Q
... Q
.. Q
. Q
Q
;
CONSCHEK(GM0CON,GMSERV,GMPROC,GMPROT,GMCLPR) ;
; *** Consult active & part of config?
N GMFILE,GMGLOB
I $$CONSOKAY^GMRCCD(GM0CON)>0 D
. F GMFILE=101,123.3 D
.. S GMGLOB(GMFILE)=$$GLOBROOT^GMRCCD(GMFILE,";")
.. Q
. S GMSERV=$$GET1^DIQ(123,GM0CON,1,"I")
. S GMCLPR=$$GET1^DIQ(123,GM0CON,1.01,"I")
. S (GMPROC,GMPROT)=$$GET1^DIQ(123,GM0CON,4,"I")
. S GMPROC=$S(GMPROC[GMGLOB(123.3):GMPROC,1:"")
. S GMPROT=$S(GMPROT[GMGLOB(101):GMPROT,1:"")
. S GMCLPR(0)=''$D(^GMR(123.033,GM0CFG,"CLPR","B",+GMCLPR))
. S GMSERV(0)=''$D(^GMR(123.033,GM0CFG,"CONS","B",+GMSERV))
. S GMPROC(0)=''$D(^GMR(123.033,GM0CFG,"CONP","B",+GMPROC))
. S GMPROT(0)=''$D(^GMR(123.033,GM0CFG,"PROT","B",+GMPROT))
. S GMSERV=$S(GMSERV(0):$$GET1^DIQ(123,GM0CON,1),1:"")
. S GMCLPR=$S(GMCLPR(0):$$GET1^DIQ(123,GM0CON,1.01),1:"")
. S GMPROC=$S(GMPROC(0):$$GET1^DIQ(123,GM0CON,4),1:"")
. S GMPROT=$S(GMPROT(0):$$GET1^DIQ(123,GM0CON,4),1:"")
. Q
E D
. S (GMSERV,GMPROC,GMPROT,GMCLPR)=""
. S (GMSERV(0),GMPROC(0),GMPROT(0),GMCLPR(0))=0
. Q
Q (GMSERV(0)!GMPROC(0)!GMPROT(0)!GMCLPR(0))
;
APPTCHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMAPPT,GMNOTE,GMOPUT) ;
; *** Check for appts
N GMTAPT
S GMTAPT=$$APPTLIST(GMROOT,GM0CFG,GM0DFN,GMTCON,GMAPPT)
; Only seen Pts
I GMAPPT>0 D
. ; Pt has been seen
. I GMTAPT>0 D
.. D NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT)
.. Q
. Q
; Only unseen Pts
E D
. ; Pt has NOT been seen
. I (GMTAPT'>0)!($$UNSEEN^GMRCCD($P(GMTAPT,U,4))>0) D
.. D NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT)
.. Q
. Q
Q
;
NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT) ;
; *** Check for notes
N GMTNOT
K @GMROOT@("NOTE-LIST")
S GMTNOT=$$NOTELIST(GMROOT,GM0CFG,GM0DFN,+GMTAPT,+GMTCON,GMOPUT)
; Only Pts with notes
I GMNOTE>0 D
. ; Pt has note
. I GMTNOT>0 D
.. D SETDATA(GMROOT,GM0DFN,GM0CON,GMTAPT,GMTNOT,GMOPUT)
.. Q
. Q
; Only Pts without notes
E D
. ; Pt does NOT have note
. I GMTNOT'>0 D
.. I $O(@GMROOT@("NOTE-LIST",0))'>0 S @GMROOT@("NOTE-LIST",1)="^^*NO NOTE*" ; GMRCC*2.1*1
.. D SETDATA(GMROOT,GM0DFN,GM0CON,GMTAPT,GMTNOT,GMOPUT)
.. Q
. Q
K @GMROOT@("NOTE-LIST")
Q
;
APPTLIST(GMROOT,GM0CFG,GM0DFN,GMTCON,GMAPPT) ;
; *** Get Pt's appts
; $$APPTLIST() = ApptDate ^ ClinIEN ^ ClinName ^ ApptStatInt ^ ApptStatExt
N GMCLIN,GMDATA,GMDATE,GMDAYS,GMFRST,GMLAST
N GMLIST,GMSDAM,GMSTAT,GMTAPT,GMVSIT
S GMDAYS=$$GET1^DIQ(123.033,GM0CFG,.04)
S GMLAST=$$FMADD^XLFDT(GMTCON,GMDAYS,0,0,0)
S GMLAST=$$MIN^XLFMTH(GMLAST,$$NOW^XLFDT)
S GMSDAM("FLDS")="1;2;3"
S GMSDAM("SORT")="P"
S GMSDAM(1)=GMTCON_";"_GMLAST
S GMSDAM(2)=$$OREF^DILF($NA(@GMROOT@("XREF-CLIN")))
S GMSDAM(4)=GM0DFN
S GMLIST=$NA(^TMP($J,"SDAMA301"))
K @GMLIST
S GMVSIT=""
I $$SDAPI^SDAMA301(.GMSDAM)'=-1 D
. S GMTAPT=0,GMFRST=""
. F S GMTAPT=$O(@GMLIST@(GM0DFN,GMTAPT)) Q:(GMTAPT'>0)!(GMVSIT>0) D
.. S GMDATA=$G(@GMLIST@(GM0DFN,GMTAPT))
.. S GMCLIN=$P($P(GMDATA,U,2),";",1)
.. S GMSTAT=$P($P(GMDATA,U,3),";",1)
.. I (GMTAPT>0)&(GMCLIN>0) D
... ; Appt already used?
... I '$D(@GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,GMTAPT)) D
.... ; Save first cancelled/no-show appt
.... I (GMFRST="")&($$UNSEEN^GMRCCD(GMSTAT)>0) S GMFRST=GMDATA
.... ; Appt kept?
.... I $$SEEN^GMRCCD(GMSTAT)>0 D
..... ; Mark appt used
..... S @GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,+GMTAPT)=""
..... S GMVSIT=GMDATA
..... Q
.... Q
... Q
.. Q
. ; (No kept appt found) & (cancelled/no-show appt found)
. I (GMVSIT'>0)&(GMFRST]"")&(GMAPPT'>0) D
.. S GMTAPT=$P(GMFRST,U,1)
.. S GMCLIN=$P(GMFRST,U,2)
.. ; Mark appt used
.. S @GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,+GMTAPT)=""
.. S GMVSIT=GMFRST
.. Q
. Q
K @GMLIST
S GMDATE=$P(GMVSIT,U,1)
S GMCLIN("I")=$P($P(GMVSIT,U,2),";",1)
S GMCLIN("E")=$P($P(GMVSIT,U,2),";",2)
S GMSTAT("I")=$P($P(GMVSIT,U,3),";",1)
S GMSTAT("E")=$P($P(GMVSIT,U,3),";",2)
S GMVSIT=GMDATE_U_GMCLIN("I")_U_GMCLIN("E")_U
S GMVSIT=GMVSIT_GMSTAT("I")_U_GMSTAT("E")
Q GMVSIT
;
NOTELIST(GMROOT,GM0CFG,GM0DFN,GMTAPT,GMTCON,GMOPUT) ;
; *** Get Pt's notes
; $$NOTELIST() = RefDate ^ TitleIEN ^ TitleName ^ NoteIEN
N GM0NOT,GMCLAS,GMDATA,GMDATE,GMDAYS,GMINDX
N GMTFIN,GMSTAT,GMTITL,GMTNOT,GM0TTL
S GMDATE=$S(GMTAPT>0:GMTAPT,1:GMTCON)
S GMDAYS=$$GET1^DIQ(123.033,GM0CFG,$S(GMTAPT>0:.05,1:.04))
S GMTFIN=9999999-$$FMADD^XLFDT(GMDATE\1,GMDAYS,0,0,0)
D NOTESTAT^GMRCCD(.GMSTAT)
S (GMCLAS,GMTITL)=0
F S GMCLAS=$O(^TIU(8925,"ADCPT",GM0DFN,GMCLAS)) Q:$$NOTEQUIT(GMCLAS,GMTITL,GMOPUT) D
. S GMSTAT=0
. F S GMSTAT=$O(GMSTAT(GMSTAT)) Q:$$NOTEQUIT(GMSTAT,GMTITL,GMOPUT) D
.. S GMTNOT=9999999-(GMDATE\1)
.. F S GMTNOT=$O(^TIU(8925,"ADCPT",GM0DFN,GMCLAS,GMSTAT,GMTNOT),-1) Q:$$NOTEQUIT(GMTNOT,GMTITL,GMOPUT)!(GMTNOT<GMTFIN) D
... S GM0NOT=0
... F S GM0NOT=$O(^TIU(8925,"ADCPT",GM0DFN,GMCLAS,GMSTAT,GMTNOT,GM0NOT)) Q:$$NOTEQUIT(GM0NOT,GMTITL,GMOPUT) D
.... ; Note part of config?
.... S GM0TTL=$$GET1^DIQ(8925,GM0NOT,.01,"I")
.... I $D(^GMR(123.033,GM0CFG,"NOTE","B",+GM0TTL)) D
..... S GMDATA=$$GET1^DIQ(8925,GM0NOT,1301,"I")
..... S GMDATA=GMDATA_U_$$GET1^DIQ(8925,GM0NOT,.01,"I")
..... S GMDATA=GMDATA_U_$$GET1^DIQ(8925,GM0NOT,.01)
..... S GMDATA=GMDATA_U_GM0NOT
..... I ((GMOPUT["I")!(GMOPUT["P"))&(GMOPUT'["C") D
...... S GMINDX=1+$O(@GMROOT@("NOTE-LIST",1E25),-1)
...... S @GMROOT@("NOTE-LIST",GMINDX)=GMDATA
...... Q
..... ; Note already used?
..... I '$D(@GMROOT@("XREF-NOTE",GM0DFN,GM0NOT)) D
...... ; Mark note used
...... S @GMROOT@("XREF-NOTE",GM0DFN,GM0NOT)=""
...... S GMTITL=GMDATA
...... Q
..... Q
.... Q
... Q
.. Q
. Q
Q GMTITL
;
NOTEQUIT(GMORDR,GMTITL,GMOPUT) ;
; *** Stop note search?
Q $S(GMORDR'>0:1,GMOPUT["I":0,1:''GMTITL)
;
SETDATA(GMROOT,GM0DFN,GM0CON,GMADAT,GMNDAT,GMOPUT) ;
; *** Save report data
N GMCLIN,GMCLPR,GMCNAM,GMDATA,GMINDX,GMNAME
N GMNOTE,GMPROC,GMPROT,GMSERV,GMSSN,GMSTAT
N GMTAPT,GMTCON,GMTNOT
S GMTCON=$$GET1^DIQ(123,GM0CON,3,"I")
S GMCNAM="*NO CONSULT*"
I $$CONSCHEK(GM0CON,.GMSERV,.GMPROC,.GMPROT,.GMCLPR) D
. I GMCLPR(0) S GMCNAM=GMCLPR
. I GMPROT(0) S GMCNAM=GMPROT
. I GMPROC(0) S GMCNAM=GMPROC
. I GMSERV(0) S GMCNAM=GMSERV
. Q
S GMCNAM=GMCNAM_U_(+GM0CON)
;
S GMNAME=$$GET1^DIQ(2,GM0DFN,.01)
S GMNAME=$S(GMNAME]"":GMNAME,1:"*NO PATIENT*")
S GMNAME=GMNAME_U_(+GM0DFN)
S GMSSN=$$GET1^DIQ(2,GM0DFN,.09)
;
S GMCLIN=$P(GMADAT,U,3)
S GMCLIN=$S(GMCLIN]"":GMCLIN,1:"*NO CLINIC*")
S GMCLIN=GMCLIN_U_(+$P(GMADAT,U,2))
S GMTAPT=$P(GMADAT,U,1)
S GMSTAT("I")=$P(GMADAT,U,4)
S GMSTAT("E")=$P(GMADAT,U,5)
;
S GMNOTE=$P(GMNDAT,U,3)
S GMNOTE=$S(GMNOTE]"":GMNOTE,1:"*NO NOTE*")
S GMNOTE=GMNOTE_U_(+$P(GMNDAT,U,2))_U_(+$P(GMNDAT,U,4))
S GMTNOT=$P(GMNDAT,U,1)
;
S GMDATA=GMSSN_U_GMTCON_U_GMTAPT_U
S GMDATA=GMDATA_GMSTAT("I")_U_GMSTAT("E")_U
S GMDATA=GMDATA_GMTNOT_U_GM0CON_U_(+$P(GMNDAT,U,4))_U
S GMDATA=GMDATA_"0"_U_""
;
; Data = SSN ^ ConsultDate ^ ApptDate ^ ApptStatusInt ^ ApptStatusExt ^
; NoteDate ^ ConsultIEN ^ NoteIEN ^ ConsultUpdated ^ ConsultUpdateMsg
;
I ((GMOPUT["I")!(GMOPUT["P"))&(GMOPUT'["C") D
. S GMINDX=0
. F S GMINDX=$O(@GMROOT@("NOTE-LIST",GMINDX)) Q:GMINDX'>0 D
.. S GMNOTE=$G(@GMROOT@("NOTE-LIST",GMINDX))
.. S $P(GMDATA,U,6)=$P(GMNOTE,U,1)
.. S $P(GMDATA,U,8)=$P(GMNOTE,U,4)
.. S GMNOTE=$P(GMNOTE,U,3)_U_$P(GMNOTE,U,2)_U_$P(GMNOTE,U,4)
.. I GMOPUT["I" D
... ; Root("DATA", PtName ^ PtIEN, Consult ^ ConsultIEN,
... ; Title ^ TitleIEN ^ NoteIEN) = Data
... S @GMROOT@("DATA",GMNAME,GMCNAM,GMNOTE)=GMDATA
... Q
.. E D
... ; Root("DATA", Consult ^ ConsultIEN, Clin ^ ClinIEN,
... ; PtName ^ PtIEN, Title ^ TitleIEN ^ NoteIEN) = Data
... S @GMROOT@("DATA",GMCNAM,GMCLIN,GMNAME,GMNOTE)=GMDATA
... Q
.. Q
. Q
E D
. ; Root("DATA", Consult ^ ConsultIEN, Clin ^ ClinIEN,
. ; Title ^ TitleIEN ^ NoteIEN, PtName ^ PtIEN) = Data
. S @GMROOT@("DATA",GMCNAM,GMCLIN,GMNOTE,GMNAME)=GMDATA
. Q
S @GMROOT@("XREF-DFN",GM0DFN)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCCB 9329 printed Nov 22, 2024@16:55:25 Page 2
GMRCCB ;SFVAMC/DAD - Consult Closure Tool: Data Gathering ;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 ; 6742 Controlled Sub ^TIU(8925,"ADCPT"
+8 ; 2054 Supported $$OREF^DILF
+9 ; 2056 Supported $$GET1^DIQ
+10 ; 4433 Supported $$SDAPI^SDAMA301
+11 ; 4837 Private ^GMR(123,"E"
+12 ; 10103 Supported $$FMADD^XLFDT
+13 ; 10103 Supported $$NOW^XLFDT
+14 ; 10105 Supported $$MIN^XLFMTH
+15 ;
GETDATA(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM) ;
+1 ; *** Get consults
+2 NEW GM0CON,GM0DFN,GMCLPR,GMPROC,GMPROT,GMSERV,GMTCON
+3 DO CLINLIST^GMRCCD(GMROOT,GM0CFG)
+4 SET GMTCON=GMTBEG-.0000001
+5 FOR
SET GMTCON=$ORDER(^GMR(123,"E",GMTCON))
if (GMTCON'>0)!(GMTCON>(GMTEND+.24))
QUIT
Begin DoDot:1
+6 SET GM0CON=0
+7 FOR
SET GM0CON=$ORDER(^GMR(123,"E",GMTCON,GM0CON))
if GM0CON'>0
QUIT
Begin DoDot:2
+8 IF $$CONSCHEK(GM0CON,.GMSERV,.GMPROC,.GMPROT,.GMCLPR)
Begin DoDot:3
+9 SET GM0DFN=$$GET1^DIQ(123,GM0CON,.02,"I")
+10 IF GM0DFN>0
Begin DoDot:4
+11 DO APPTCHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMAPPT,GMNOTE,GMOPUT)
+12 QUIT
End DoDot:4
+13 QUIT
End DoDot:3
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
CONSCHEK(GM0CON,GMSERV,GMPROC,GMPROT,GMCLPR) ;
+1 ; *** Consult active & part of config?
+2 NEW GMFILE,GMGLOB
+3 IF $$CONSOKAY^GMRCCD(GM0CON)>0
Begin DoDot:1
+4 FOR GMFILE=101,123.3
Begin DoDot:2
+5 SET GMGLOB(GMFILE)=$$GLOBROOT^GMRCCD(GMFILE,";")
+6 QUIT
End DoDot:2
+7 SET GMSERV=$$GET1^DIQ(123,GM0CON,1,"I")
+8 SET GMCLPR=$$GET1^DIQ(123,GM0CON,1.01,"I")
+9 SET (GMPROC,GMPROT)=$$GET1^DIQ(123,GM0CON,4,"I")
+10 SET GMPROC=$SELECT(GMPROC[GMGLOB(123.3):GMPROC,1:"")
+11 SET GMPROT=$SELECT(GMPROT[GMGLOB(101):GMPROT,1:"")
+12 SET GMCLPR(0)=''$DATA(^GMR(123.033,GM0CFG,"CLPR","B",+GMCLPR))
+13 SET GMSERV(0)=''$DATA(^GMR(123.033,GM0CFG,"CONS","B",+GMSERV))
+14 SET GMPROC(0)=''$DATA(^GMR(123.033,GM0CFG,"CONP","B",+GMPROC))
+15 SET GMPROT(0)=''$DATA(^GMR(123.033,GM0CFG,"PROT","B",+GMPROT))
+16 SET GMSERV=$SELECT(GMSERV(0):$$GET1^DIQ(123,GM0CON,1),1:"")
+17 SET GMCLPR=$SELECT(GMCLPR(0):$$GET1^DIQ(123,GM0CON,1.01),1:"")
+18 SET GMPROC=$SELECT(GMPROC(0):$$GET1^DIQ(123,GM0CON,4),1:"")
+19 SET GMPROT=$SELECT(GMPROT(0):$$GET1^DIQ(123,GM0CON,4),1:"")
+20 QUIT
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 SET (GMSERV,GMPROC,GMPROT,GMCLPR)=""
+23 SET (GMSERV(0),GMPROC(0),GMPROT(0),GMCLPR(0))=0
+24 QUIT
End DoDot:1
+25 QUIT (GMSERV(0)!GMPROC(0)!GMPROT(0)!GMCLPR(0))
+26 ;
APPTCHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMAPPT,GMNOTE,GMOPUT) ;
+1 ; *** Check for appts
+2 NEW GMTAPT
+3 SET GMTAPT=$$APPTLIST(GMROOT,GM0CFG,GM0DFN,GMTCON,GMAPPT)
+4 ; Only seen Pts
+5 IF GMAPPT>0
Begin DoDot:1
+6 ; Pt has been seen
+7 IF GMTAPT>0
Begin DoDot:2
+8 DO NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT)
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 ; Only unseen Pts
+12 IF '$TEST
Begin DoDot:1
+13 ; Pt has NOT been seen
+14 IF (GMTAPT'>0)!($$UNSEEN^GMRCCD($PIECE(GMTAPT,U,4))>0)
Begin DoDot:2
+15 DO NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT)
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT) ;
+1 ; *** Check for notes
+2 NEW GMTNOT
+3 KILL @GMROOT@("NOTE-LIST")
+4 SET GMTNOT=$$NOTELIST(GMROOT,GM0CFG,GM0DFN,+GMTAPT,+GMTCON,GMOPUT)
+5 ; Only Pts with notes
+6 IF GMNOTE>0
Begin DoDot:1
+7 ; Pt has note
+8 IF GMTNOT>0
Begin DoDot:2
+9 DO SETDATA(GMROOT,GM0DFN,GM0CON,GMTAPT,GMTNOT,GMOPUT)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 ; Only Pts without notes
+13 IF '$TEST
Begin DoDot:1
+14 ; Pt does NOT have note
+15 IF GMTNOT'>0
Begin DoDot:2
+16 ; GMRCC*2.1*1
IF $ORDER(@GMROOT@("NOTE-LIST",0))'>0
SET @GMROOT@("NOTE-LIST",1)="^^*NO NOTE*"
+17 DO SETDATA(GMROOT,GM0DFN,GM0CON,GMTAPT,GMTNOT,GMOPUT)
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 KILL @GMROOT@("NOTE-LIST")
+21 QUIT
+22 ;
APPTLIST(GMROOT,GM0CFG,GM0DFN,GMTCON,GMAPPT) ;
+1 ; *** Get Pt's appts
+2 ; $$APPTLIST() = ApptDate ^ ClinIEN ^ ClinName ^ ApptStatInt ^ ApptStatExt
+3 NEW GMCLIN,GMDATA,GMDATE,GMDAYS,GMFRST,GMLAST
+4 NEW GMLIST,GMSDAM,GMSTAT,GMTAPT,GMVSIT
+5 SET GMDAYS=$$GET1^DIQ(123.033,GM0CFG,.04)
+6 SET GMLAST=$$FMADD^XLFDT(GMTCON,GMDAYS,0,0,0)
+7 SET GMLAST=$$MIN^XLFMTH(GMLAST,$$NOW^XLFDT)
+8 SET GMSDAM("FLDS")="1;2;3"
+9 SET GMSDAM("SORT")="P"
+10 SET GMSDAM(1)=GMTCON_";"_GMLAST
+11 SET GMSDAM(2)=$$OREF^DILF($NAME(@GMROOT@("XREF-CLIN")))
+12 SET GMSDAM(4)=GM0DFN
+13 SET GMLIST=$NAME(^TMP($JOB,"SDAMA301"))
+14 KILL @GMLIST
+15 SET GMVSIT=""
+16 IF $$SDAPI^SDAMA301(.GMSDAM)'=-1
Begin DoDot:1
+17 SET GMTAPT=0
SET GMFRST=""
+18 FOR
SET GMTAPT=$ORDER(@GMLIST@(GM0DFN,GMTAPT))
if (GMTAPT'>0)!(GMVSIT>0)
QUIT
Begin DoDot:2
+19 SET GMDATA=$GET(@GMLIST@(GM0DFN,GMTAPT))
+20 SET GMCLIN=$PIECE($PIECE(GMDATA,U,2),";",1)
+21 SET GMSTAT=$PIECE($PIECE(GMDATA,U,3),";",1)
+22 IF (GMTAPT>0)&(GMCLIN>0)
Begin DoDot:3
+23 ; Appt already used?
+24 IF '$DATA(@GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,GMTAPT))
Begin DoDot:4
+25 ; Save first cancelled/no-show appt
+26 IF (GMFRST="")&($$UNSEEN^GMRCCD(GMSTAT)>0)
SET GMFRST=GMDATA
+27 ; Appt kept?
+28 IF $$SEEN^GMRCCD(GMSTAT)>0
Begin DoDot:5
+29 ; Mark appt used
+30 SET @GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,+GMTAPT)=""
+31 SET GMVSIT=GMDATA
+32 QUIT
End DoDot:5
+33 QUIT
End DoDot:4
+34 QUIT
End DoDot:3
+35 QUIT
End DoDot:2
+36 ; (No kept appt found) & (cancelled/no-show appt found)
+37 IF (GMVSIT'>0)&(GMFRST]"")&(GMAPPT'>0)
Begin DoDot:2
+38 SET GMTAPT=$PIECE(GMFRST,U,1)
+39 SET GMCLIN=$PIECE(GMFRST,U,2)
+40 ; Mark appt used
+41 SET @GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,+GMTAPT)=""
+42 SET GMVSIT=GMFRST
+43 QUIT
End DoDot:2
+44 QUIT
End DoDot:1
+45 KILL @GMLIST
+46 SET GMDATE=$PIECE(GMVSIT,U,1)
+47 SET GMCLIN("I")=$PIECE($PIECE(GMVSIT,U,2),";",1)
+48 SET GMCLIN("E")=$PIECE($PIECE(GMVSIT,U,2),";",2)
+49 SET GMSTAT("I")=$PIECE($PIECE(GMVSIT,U,3),";",1)
+50 SET GMSTAT("E")=$PIECE($PIECE(GMVSIT,U,3),";",2)
+51 SET GMVSIT=GMDATE_U_GMCLIN("I")_U_GMCLIN("E")_U
+52 SET GMVSIT=GMVSIT_GMSTAT("I")_U_GMSTAT("E")
+53 QUIT GMVSIT
+54 ;
NOTELIST(GMROOT,GM0CFG,GM0DFN,GMTAPT,GMTCON,GMOPUT) ;
+1 ; *** Get Pt's notes
+2 ; $$NOTELIST() = RefDate ^ TitleIEN ^ TitleName ^ NoteIEN
+3 NEW GM0NOT,GMCLAS,GMDATA,GMDATE,GMDAYS,GMINDX
+4 NEW GMTFIN,GMSTAT,GMTITL,GMTNOT,GM0TTL
+5 SET GMDATE=$SELECT(GMTAPT>0:GMTAPT,1:GMTCON)
+6 SET GMDAYS=$$GET1^DIQ(123.033,GM0CFG,$SELECT(GMTAPT>0:.05,1:.04))
+7 SET GMTFIN=9999999-$$FMADD^XLFDT(GMDATE\1,GMDAYS,0,0,0)
+8 DO NOTESTAT^GMRCCD(.GMSTAT)
+9 SET (GMCLAS,GMTITL)=0
+10 FOR
SET GMCLAS=$ORDER(^TIU(8925,"ADCPT",GM0DFN,GMCLAS))
if $$NOTEQUIT(GMCLAS,GMTITL,GMOPUT)
QUIT
Begin DoDot:1
+11 SET GMSTAT=0
+12 FOR
SET GMSTAT=$ORDER(GMSTAT(GMSTAT))
if $$NOTEQUIT(GMSTAT,GMTITL,GMOPUT)
QUIT
Begin DoDot:2
+13 SET GMTNOT=9999999-(GMDATE\1)
+14 FOR
SET GMTNOT=$ORDER(^TIU(8925,"ADCPT",GM0DFN,GMCLAS,GMSTAT,GMTNOT),-1)
if $$NOTEQUIT(GMTNOT,GMTITL,GMOPUT)!(GMTNOT<GMTFIN)
QUIT
Begin DoDot:3
+15 SET GM0NOT=0
+16 FOR
SET GM0NOT=$ORDER(^TIU(8925,"ADCPT",GM0DFN,GMCLAS,GMSTAT,GMTNOT,GM0NOT))
if $$NOTEQUIT(GM0NOT,GMTITL,GMOPUT)
QUIT
Begin DoDot:4
+17 ; Note part of config?
+18 SET GM0TTL=$$GET1^DIQ(8925,GM0NOT,.01,"I")
+19 IF $DATA(^GMR(123.033,GM0CFG,"NOTE","B",+GM0TTL))
Begin DoDot:5
+20 SET GMDATA=$$GET1^DIQ(8925,GM0NOT,1301,"I")
+21 SET GMDATA=GMDATA_U_$$GET1^DIQ(8925,GM0NOT,.01,"I")
+22 SET GMDATA=GMDATA_U_$$GET1^DIQ(8925,GM0NOT,.01)
+23 SET GMDATA=GMDATA_U_GM0NOT
+24 IF ((GMOPUT["I")!(GMOPUT["P"))&(GMOPUT'["C")
Begin DoDot:6
+25 SET GMINDX=1+$ORDER(@GMROOT@("NOTE-LIST",1E25),-1)
+26 SET @GMROOT@("NOTE-LIST",GMINDX)=GMDATA
+27 QUIT
End DoDot:6
+28 ; Note already used?
+29 IF '$DATA(@GMROOT@("XREF-NOTE",GM0DFN,GM0NOT))
Begin DoDot:6
+30 ; Mark note used
+31 SET @GMROOT@("XREF-NOTE",GM0DFN,GM0NOT)=""
+32 SET GMTITL=GMDATA
+33 QUIT
End DoDot:6
+34 QUIT
End DoDot:5
+35 QUIT
End DoDot:4
+36 QUIT
End DoDot:3
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 QUIT GMTITL
+40 ;
NOTEQUIT(GMORDR,GMTITL,GMOPUT) ;
+1 ; *** Stop note search?
+2 QUIT $SELECT(GMORDR'>0:1,GMOPUT["I":0,1:''GMTITL)
+3 ;
SETDATA(GMROOT,GM0DFN,GM0CON,GMADAT,GMNDAT,GMOPUT) ;
+1 ; *** Save report data
+2 NEW GMCLIN,GMCLPR,GMCNAM,GMDATA,GMINDX,GMNAME
+3 NEW GMNOTE,GMPROC,GMPROT,GMSERV,GMSSN,GMSTAT
+4 NEW GMTAPT,GMTCON,GMTNOT
+5 SET GMTCON=$$GET1^DIQ(123,GM0CON,3,"I")
+6 SET GMCNAM="*NO CONSULT*"
+7 IF $$CONSCHEK(GM0CON,.GMSERV,.GMPROC,.GMPROT,.GMCLPR)
Begin DoDot:1
+8 IF GMCLPR(0)
SET GMCNAM=GMCLPR
+9 IF GMPROT(0)
SET GMCNAM=GMPROT
+10 IF GMPROC(0)
SET GMCNAM=GMPROC
+11 IF GMSERV(0)
SET GMCNAM=GMSERV
+12 QUIT
End DoDot:1
+13 SET GMCNAM=GMCNAM_U_(+GM0CON)
+14 ;
+15 SET GMNAME=$$GET1^DIQ(2,GM0DFN,.01)
+16 SET GMNAME=$SELECT(GMNAME]"":GMNAME,1:"*NO PATIENT*")
+17 SET GMNAME=GMNAME_U_(+GM0DFN)
+18 SET GMSSN=$$GET1^DIQ(2,GM0DFN,.09)
+19 ;
+20 SET GMCLIN=$PIECE(GMADAT,U,3)
+21 SET GMCLIN=$SELECT(GMCLIN]"":GMCLIN,1:"*NO CLINIC*")
+22 SET GMCLIN=GMCLIN_U_(+$PIECE(GMADAT,U,2))
+23 SET GMTAPT=$PIECE(GMADAT,U,1)
+24 SET GMSTAT("I")=$PIECE(GMADAT,U,4)
+25 SET GMSTAT("E")=$PIECE(GMADAT,U,5)
+26 ;
+27 SET GMNOTE=$PIECE(GMNDAT,U,3)
+28 SET GMNOTE=$SELECT(GMNOTE]"":GMNOTE,1:"*NO NOTE*")
+29 SET GMNOTE=GMNOTE_U_(+$PIECE(GMNDAT,U,2))_U_(+$PIECE(GMNDAT,U,4))
+30 SET GMTNOT=$PIECE(GMNDAT,U,1)
+31 ;
+32 SET GMDATA=GMSSN_U_GMTCON_U_GMTAPT_U
+33 SET GMDATA=GMDATA_GMSTAT("I")_U_GMSTAT("E")_U
+34 SET GMDATA=GMDATA_GMTNOT_U_GM0CON_U_(+$PIECE(GMNDAT,U,4))_U
+35 SET GMDATA=GMDATA_"0"_U_""
+36 ;
+37 ; Data = SSN ^ ConsultDate ^ ApptDate ^ ApptStatusInt ^ ApptStatusExt ^
+38 ; NoteDate ^ ConsultIEN ^ NoteIEN ^ ConsultUpdated ^ ConsultUpdateMsg
+39 ;
+40 IF ((GMOPUT["I")!(GMOPUT["P"))&(GMOPUT'["C")
Begin DoDot:1
+41 SET GMINDX=0
+42 FOR
SET GMINDX=$ORDER(@GMROOT@("NOTE-LIST",GMINDX))
if GMINDX'>0
QUIT
Begin DoDot:2
+43 SET GMNOTE=$GET(@GMROOT@("NOTE-LIST",GMINDX))
+44 SET $PIECE(GMDATA,U,6)=$PIECE(GMNOTE,U,1)
+45 SET $PIECE(GMDATA,U,8)=$PIECE(GMNOTE,U,4)
+46 SET GMNOTE=$PIECE(GMNOTE,U,3)_U_$PIECE(GMNOTE,U,2)_U_$PIECE(GMNOTE,U,4)
+47 IF GMOPUT["I"
Begin DoDot:3
+48 ; Root("DATA", PtName ^ PtIEN, Consult ^ ConsultIEN,
+49 ; Title ^ TitleIEN ^ NoteIEN) = Data
+50 SET @GMROOT@("DATA",GMNAME,GMCNAM,GMNOTE)=GMDATA
+51 QUIT
End DoDot:3
+52 IF '$TEST
Begin DoDot:3
+53 ; Root("DATA", Consult ^ ConsultIEN, Clin ^ ClinIEN,
+54 ; PtName ^ PtIEN, Title ^ TitleIEN ^ NoteIEN) = Data
+55 SET @GMROOT@("DATA",GMCNAM,GMCLIN,GMNAME,GMNOTE)=GMDATA
+56 QUIT
End DoDot:3
+57 QUIT
End DoDot:2
+58 QUIT
End DoDot:1
+59 IF '$TEST
Begin DoDot:1
+60 ; Root("DATA", Consult ^ ConsultIEN, Clin ^ ClinIEN,
+61 ; Title ^ TitleIEN ^ NoteIEN, PtName ^ PtIEN) = Data
+62 SET @GMROOT@("DATA",GMCNAM,GMCLIN,GMNOTE,GMNAME)=GMDATA
+63 QUIT
End DoDot:1
+64 SET @GMROOT@("XREF-DFN",GM0DFN)=""
+65 QUIT
