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

GMRCCB.m

Go to the documentation of this file. 
  1. 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
  1.  ;Consult Closure Tool
  1.  ;
  1.  ; IA#    Usage             Component
  1.  ; ---------------------------
  1.  ;  2699  Private           ^TIU(8925,D0,0  
  1.  ;  6742  Controlled Sub    ^TIU(8925,"ADCPT"
  1.  ;  2054  Supported         $$OREF^DILF
  1.  ;  2056  Supported         $$GET1^DIQ
  1.  ;  4433  Supported         $$SDAPI^SDAMA301
  1.  ;  4837  Private           ^GMR(123,"E"
  1.  ; 10103  Supported         $$FMADD^XLFDT
  1.  ; 10103  Supported         $$NOW^XLFDT
  1.  ; 10105  Supported         $$MIN^XLFMTH
  1.  ;
  1. GETDATA(GMROOT,GMTBEG,GMTEND,GM0CFG,GMAPPT,GMNOTE,GMOPUT,GMDLIM) ;
  1.  ; *** Get consults
  1.  N GM0CON,GM0DFN,GMCLPR,GMPROC,GMPROT,GMSERV,GMTCON
  1.  D CLINLIST^GMRCCD(GMROOT,GM0CFG)
  1.  S GMTCON=GMTBEG-.0000001
  1.  F  S GMTCON=$O(^GMR(123,"E",GMTCON)) Q:(GMTCON'>0)!(GMTCON>(GMTEND+.24))  D
  1.  . S GM0CON=0
  1.  . F  S GM0CON=$O(^GMR(123,"E",GMTCON,GM0CON)) Q:GM0CON'>0  D
  1.  .. I $$CONSCHEK(GM0CON,.GMSERV,.GMPROC,.GMPROT,.GMCLPR) D
  1.  ... S GM0DFN=$$GET1^DIQ(123,GM0CON,.02,"I")
  1.  ... I GM0DFN>0 D
  1.  .... D APPTCHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMAPPT,GMNOTE,GMOPUT)
  1.  .... Q
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  Q
  1.  ;
  1. CONSCHEK(GM0CON,GMSERV,GMPROC,GMPROT,GMCLPR) ;
  1.  ; *** Consult active & part of config?
  1.  N GMFILE,GMGLOB
  1.  I $$CONSOKAY^GMRCCD(GM0CON)>0 D
  1.  . F GMFILE=101,123.3 D
  1.  .. S GMGLOB(GMFILE)=$$GLOBROOT^GMRCCD(GMFILE,";")
  1.  .. Q
  1.  . S GMSERV=$$GET1^DIQ(123,GM0CON,1,"I")
  1.  . S GMCLPR=$$GET1^DIQ(123,GM0CON,1.01,"I")
  1.  . S (GMPROC,GMPROT)=$$GET1^DIQ(123,GM0CON,4,"I")
  1.  . S GMPROC=$S(GMPROC[GMGLOB(123.3):GMPROC,1:"")
  1.  . S GMPROT=$S(GMPROT[GMGLOB(101):GMPROT,1:"")
  1.  . S GMCLPR(0)=''$D(^GMR(123.033,GM0CFG,"CLPR","B",+GMCLPR))
  1.  . S GMSERV(0)=''$D(^GMR(123.033,GM0CFG,"CONS","B",+GMSERV))
  1.  . S GMPROC(0)=''$D(^GMR(123.033,GM0CFG,"CONP","B",+GMPROC))
  1.  . S GMPROT(0)=''$D(^GMR(123.033,GM0CFG,"PROT","B",+GMPROT))
  1.  . S GMSERV=$S(GMSERV(0):$$GET1^DIQ(123,GM0CON,1),1:"")
  1.  . S GMCLPR=$S(GMCLPR(0):$$GET1^DIQ(123,GM0CON,1.01),1:"")
  1.  . S GMPROC=$S(GMPROC(0):$$GET1^DIQ(123,GM0CON,4),1:"")
  1.  . S GMPROT=$S(GMPROT(0):$$GET1^DIQ(123,GM0CON,4),1:"")
  1.  . Q
  1.  E  D
  1.  . S (GMSERV,GMPROC,GMPROT,GMCLPR)=""
  1.  . S (GMSERV(0),GMPROC(0),GMPROT(0),GMCLPR(0))=0
  1.  . Q
  1.  Q (GMSERV(0)!GMPROC(0)!GMPROT(0)!GMCLPR(0))
  1.  ;
  1. APPTCHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMAPPT,GMNOTE,GMOPUT) ;
  1.  ; *** Check for appts
  1.  N GMTAPT
  1.  S GMTAPT=$$APPTLIST(GMROOT,GM0CFG,GM0DFN,GMTCON,GMAPPT)
  1.  ; Only seen Pts
  1.  I GMAPPT>0 D
  1.  . ; Pt has been seen
  1.  . I GMTAPT>0 D
  1.  .. D NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT)
  1.  .. Q
  1.  . Q
  1.  ; Only unseen Pts
  1.  E  D
  1.  . ; Pt has NOT been seen
  1.  . I (GMTAPT'>0)!($$UNSEEN^GMRCCD($P(GMTAPT,U,4))>0) D
  1.  .. D NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT)
  1.  .. Q
  1.  . Q
  1.  Q
  1.  ;
  1. NOTECHEK(GMROOT,GM0CFG,GM0DFN,GM0CON,GMTCON,GMTAPT,GMNOTE,GMOPUT) ;
  1.  ; *** Check for notes
  1.  N GMTNOT
  1.  K @GMROOT@("NOTE-LIST")
  1.  S GMTNOT=$$NOTELIST(GMROOT,GM0CFG,GM0DFN,+GMTAPT,+GMTCON,GMOPUT)
  1.  ; Only Pts with notes
  1.  I GMNOTE>0 D
  1.  . ; Pt has note
  1.  . I GMTNOT>0 D
  1.  .. D SETDATA(GMROOT,GM0DFN,GM0CON,GMTAPT,GMTNOT,GMOPUT)
  1.  .. Q
  1.  . Q
  1.  ; Only Pts without notes
  1.  E  D
  1.  . ; Pt does NOT have note
  1.  . I GMTNOT'>0 D
  1.  .. I $O(@GMROOT@("NOTE-LIST",0))'>0 S @GMROOT@("NOTE-LIST",1)="^^*NO NOTE*" ; GMRCC*2.1*1
  1.  .. D SETDATA(GMROOT,GM0DFN,GM0CON,GMTAPT,GMTNOT,GMOPUT)
  1.  .. Q
  1.  . Q
  1.  K @GMROOT@("NOTE-LIST")
  1.  Q
  1.  ;
  1. APPTLIST(GMROOT,GM0CFG,GM0DFN,GMTCON,GMAPPT) ;
  1.  ; *** Get Pt's appts
  1.  ; $$APPTLIST() = ApptDate ^ ClinIEN ^ ClinName ^ ApptStatInt ^ ApptStatExt
  1.  N GMCLIN,GMDATA,GMDATE,GMDAYS,GMFRST,GMLAST
  1.  N GMLIST,GMSDAM,GMSTAT,GMTAPT,GMVSIT
  1.  S GMDAYS=$$GET1^DIQ(123.033,GM0CFG,.04)
  1.  S GMLAST=$$FMADD^XLFDT(GMTCON,GMDAYS,0,0,0)
  1.  S GMLAST=$$MIN^XLFMTH(GMLAST,$$NOW^XLFDT)
  1.  S GMSDAM("FLDS")="1;2;3"
  1.  S GMSDAM("SORT")="P"
  1.  S GMSDAM(1)=GMTCON_";"_GMLAST
  1.  S GMSDAM(2)=$$OREF^DILF($NA(@GMROOT@("XREF-CLIN")))
  1.  S GMSDAM(4)=GM0DFN
  1.  S GMLIST=$NA(^TMP($J,"SDAMA301"))
  1.  K @GMLIST
  1.  S GMVSIT=""
  1.  I $$SDAPI^SDAMA301(.GMSDAM)'=-1 D
  1.  . S GMTAPT=0,GMFRST=""
  1.  . F  S GMTAPT=$O(@GMLIST@(GM0DFN,GMTAPT)) Q:(GMTAPT'>0)!(GMVSIT>0)  D
  1.  .. S GMDATA=$G(@GMLIST@(GM0DFN,GMTAPT))
  1.  .. S GMCLIN=$P($P(GMDATA,U,2),";",1)
  1.  .. S GMSTAT=$P($P(GMDATA,U,3),";",1)
  1.  .. I (GMTAPT>0)&(GMCLIN>0) D
  1.  ... ; Appt already used?
  1.  ... I '$D(@GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,GMTAPT)) D
  1.  .... ; Save first cancelled/no-show appt
  1.  .... I (GMFRST="")&($$UNSEEN^GMRCCD(GMSTAT)>0) S GMFRST=GMDATA
  1.  .... ; Appt kept?
  1.  .... I $$SEEN^GMRCCD(GMSTAT)>0 D
  1.  ..... ; Mark appt used
  1.  ..... S @GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,+GMTAPT)=""
  1.  ..... S GMVSIT=GMDATA
  1.  ..... Q
  1.  .... Q
  1.  ... Q
  1.  .. Q
  1.  . ; (No kept appt found) & (cancelled/no-show appt found)
  1.  . I (GMVSIT'>0)&(GMFRST]"")&(GMAPPT'>0) D
  1.  .. S GMTAPT=$P(GMFRST,U,1)
  1.  .. S GMCLIN=$P(GMFRST,U,2)
  1.  .. ; Mark appt used
  1.  .. S @GMROOT@("XREF-APPT",GM0DFN,+GMCLIN,+GMTAPT)=""
  1.  .. S GMVSIT=GMFRST
  1.  .. Q
  1.  . Q
  1.  K @GMLIST
  1.  S GMDATE=$P(GMVSIT,U,1)
  1.  S GMCLIN("I")=$P($P(GMVSIT,U,2),";",1)
  1.  S GMCLIN("E")=$P($P(GMVSIT,U,2),";",2)
  1.  S GMSTAT("I")=$P($P(GMVSIT,U,3),";",1)
  1.  S GMSTAT("E")=$P($P(GMVSIT,U,3),";",2)
  1.  S GMVSIT=GMDATE_U_GMCLIN("I")_U_GMCLIN("E")_U
  1.  S GMVSIT=GMVSIT_GMSTAT("I")_U_GMSTAT("E")
  1.  Q GMVSIT
  1.  ;
  1. NOTELIST(GMROOT,GM0CFG,GM0DFN,GMTAPT,GMTCON,GMOPUT) ;
  1.  ; *** Get Pt's notes
  1.  ; $$NOTELIST() = RefDate ^ TitleIEN ^ TitleName ^ NoteIEN
  1.  N GM0NOT,GMCLAS,GMDATA,GMDATE,GMDAYS,GMINDX
  1.  N GMTFIN,GMSTAT,GMTITL,GMTNOT,GM0TTL
  1.  S GMDATE=$S(GMTAPT>0:GMTAPT,1:GMTCON)
  1.  S GMDAYS=$$GET1^DIQ(123.033,GM0CFG,$S(GMTAPT>0:.05,1:.04))
  1.  S GMTFIN=9999999-$$FMADD^XLFDT(GMDATE\1,GMDAYS,0,0,0)
  1.  D NOTESTAT^GMRCCD(.GMSTAT)
  1.  S (GMCLAS,GMTITL)=0
  1.  F  S GMCLAS=$O(^TIU(8925,"ADCPT",GM0DFN,GMCLAS)) Q:$$NOTEQUIT(GMCLAS,GMTITL,GMOPUT)  D
  1.  . S GMSTAT=0
  1.  . F  S GMSTAT=$O(GMSTAT(GMSTAT)) Q:$$NOTEQUIT(GMSTAT,GMTITL,GMOPUT)  D
  1.  .. S GMTNOT=9999999-(GMDATE\1)
  1.  .. F  S GMTNOT=$O(^TIU(8925,"ADCPT",GM0DFN,GMCLAS,GMSTAT,GMTNOT),-1) Q:$$NOTEQUIT(GMTNOT,GMTITL,GMOPUT)!(GMTNOT<GMTFIN)  D
  1.  ... S GM0NOT=0
  1.  ... F  S GM0NOT=$O(^TIU(8925,"ADCPT",GM0DFN,GMCLAS,GMSTAT,GMTNOT,GM0NOT)) Q:$$NOTEQUIT(GM0NOT,GMTITL,GMOPUT)  D
  1.  .... ; Note part of config?
  1.  .... S GM0TTL=$$GET1^DIQ(8925,GM0NOT,.01,"I")
  1.  .... I $D(^GMR(123.033,GM0CFG,"NOTE","B",+GM0TTL)) D
  1.  ..... S GMDATA=$$GET1^DIQ(8925,GM0NOT,1301,"I")
  1.  ..... S GMDATA=GMDATA_U_$$GET1^DIQ(8925,GM0NOT,.01,"I")
  1.  ..... S GMDATA=GMDATA_U_$$GET1^DIQ(8925,GM0NOT,.01)
  1.  ..... S GMDATA=GMDATA_U_GM0NOT
  1.  ..... I ((GMOPUT["I")!(GMOPUT["P"))&(GMOPUT'["C") D
  1.  ...... S GMINDX=1+$O(@GMROOT@("NOTE-LIST",1E25),-1)
  1.  ...... S @GMROOT@("NOTE-LIST",GMINDX)=GMDATA
  1.  ...... Q
  1.  ..... ; Note already used?
  1.  ..... I '$D(@GMROOT@("XREF-NOTE",GM0DFN,GM0NOT)) D
  1.  ...... ; Mark note used
  1.  ...... S @GMROOT@("XREF-NOTE",GM0DFN,GM0NOT)=""
  1.  ...... S GMTITL=GMDATA
  1.  ...... Q
  1.  ..... Q
  1.  .... Q
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  Q GMTITL
  1.  ;
  1. NOTEQUIT(GMORDR,GMTITL,GMOPUT) ;
  1.  ; *** Stop note search?
  1.  Q $S(GMORDR'>0:1,GMOPUT["I":0,1:''GMTITL)
  1.  ;
  1. SETDATA(GMROOT,GM0DFN,GM0CON,GMADAT,GMNDAT,GMOPUT) ;
  1.  ; *** Save report data
  1.  N GMCLIN,GMCLPR,GMCNAM,GMDATA,GMINDX,GMNAME
  1.  N GMNOTE,GMPROC,GMPROT,GMSERV,GMSSN,GMSTAT
  1.  N GMTAPT,GMTCON,GMTNOT
  1.  S GMTCON=$$GET1^DIQ(123,GM0CON,3,"I")
  1.  S GMCNAM="*NO CONSULT*"
  1.  I $$CONSCHEK(GM0CON,.GMSERV,.GMPROC,.GMPROT,.GMCLPR) D
  1.  . I GMCLPR(0) S GMCNAM=GMCLPR
  1.  . I GMPROT(0) S GMCNAM=GMPROT
  1.  . I GMPROC(0) S GMCNAM=GMPROC
  1.  . I GMSERV(0) S GMCNAM=GMSERV
  1.  . Q
  1.  S GMCNAM=GMCNAM_U_(+GM0CON)
  1.  ;
  1.  S GMNAME=$$GET1^DIQ(2,GM0DFN,.01)
  1.  S GMNAME=$S(GMNAME]"":GMNAME,1:"*NO PATIENT*")
  1.  S GMNAME=GMNAME_U_(+GM0DFN)
  1.  S GMSSN=$$GET1^DIQ(2,GM0DFN,.09)
  1.  ;
  1.  S GMCLIN=$P(GMADAT,U,3)
  1.  S GMCLIN=$S(GMCLIN]"":GMCLIN,1:"*NO CLINIC*")
  1.  S GMCLIN=GMCLIN_U_(+$P(GMADAT,U,2))
  1.  S GMTAPT=$P(GMADAT,U,1)
  1.  S GMSTAT("I")=$P(GMADAT,U,4)
  1.  S GMSTAT("E")=$P(GMADAT,U,5)
  1.  ;
  1.  S GMNOTE=$P(GMNDAT,U,3)
  1.  S GMNOTE=$S(GMNOTE]"":GMNOTE,1:"*NO NOTE*")
  1.  S GMNOTE=GMNOTE_U_(+$P(GMNDAT,U,2))_U_(+$P(GMNDAT,U,4))
  1.  S GMTNOT=$P(GMNDAT,U,1)
  1.  ;
  1.  S GMDATA=GMSSN_U_GMTCON_U_GMTAPT_U
  1.  S GMDATA=GMDATA_GMSTAT("I")_U_GMSTAT("E")_U
  1.  S GMDATA=GMDATA_GMTNOT_U_GM0CON_U_(+$P(GMNDAT,U,4))_U
  1.  S GMDATA=GMDATA_"0"_U_""
  1.  ;
  1.  ; Data = SSN ^ ConsultDate ^ ApptDate ^ ApptStatusInt ^ ApptStatusExt ^
  1.  ;        NoteDate ^ ConsultIEN ^ NoteIEN ^ ConsultUpdated ^ ConsultUpdateMsg
  1.  ;
  1.  I ((GMOPUT["I")!(GMOPUT["P"))&(GMOPUT'["C") D
  1.  . S GMINDX=0
  1.  . F  S GMINDX=$O(@GMROOT@("NOTE-LIST",GMINDX)) Q:GMINDX'>0  D
  1.  .. S GMNOTE=$G(@GMROOT@("NOTE-LIST",GMINDX))
  1.  .. S $P(GMDATA,U,6)=$P(GMNOTE,U,1)
  1.  .. S $P(GMDATA,U,8)=$P(GMNOTE,U,4)
  1.  .. S GMNOTE=$P(GMNOTE,U,3)_U_$P(GMNOTE,U,2)_U_$P(GMNOTE,U,4)
  1.  .. I GMOPUT["I" D
  1.  ... ; Root("DATA", PtName ^ PtIEN, Consult ^ ConsultIEN,
  1.  ... ;      Title ^ TitleIEN ^ NoteIEN) = Data
  1.  ... S @GMROOT@("DATA",GMNAME,GMCNAM,GMNOTE)=GMDATA
  1.  ... Q
  1.  .. E  D
  1.  ... ; Root("DATA", Consult ^ ConsultIEN, Clin ^ ClinIEN,
  1.  ... ;      PtName ^ PtIEN, Title ^ TitleIEN ^ NoteIEN) = Data
  1.  ... S @GMROOT@("DATA",GMCNAM,GMCLIN,GMNAME,GMNOTE)=GMDATA
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  E  D
  1.  . ; Root("DATA", Consult ^ ConsultIEN, Clin ^ ClinIEN,
  1.  . ;      Title ^ TitleIEN ^ NoteIEN, PtName ^ PtIEN) = Data
  1.  . S @GMROOT@("DATA",GMCNAM,GMCLIN,GMNOTE,GMNAME)=GMDATA
  1.  . Q
  1.  S @GMROOT@("XREF-DFN",GM0DFN)=""
  1.  Q