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

GMRCXR.m

Go to the documentation of this file.
  1. GMRCXR ; ALB/SAT - GMR DD UTILITY ; May 25, 2023@10:25:35
  1. ;;3.0;CONSULT/REQUEST TRACKING;**83,86,169,189**;Dec 27, 1997;Build 54
  1. ;DD support for VISTA SCHEDULING ENHANCEMENT SD*5.3*627
  1. ;New x-ref utility for GMRC*3*169
  1. ;Reference is made to ICR #6184
  1. ;
  1. Q
  1. AG123S1(GMRCDA1,GMRCDR) ;build AG xref ;called by 'Set Logic' and 'Kill Logic' of the New Style AG cross reference #336 in file 123
  1. ;GMRCDA1 = DA(1) IEN pointer to REQUEST/CONSULTATION file 123
  1. ;GMRCDR = DATE OF REQUEST in FM format from field 3 of top level of file 123
  1. N CHK
  1. S GMRCDA1=$G(GMRCDA1) Q:'+GMRCDA1
  1. S GMRCDR=$G(GMRCDR,0) S:'GMRCDR GMRCDR=$P($G(^GMR(123,GMRCDA1,0)),U,7) ;alb/sat 86 setup GMRCDR if not passed in
  1. Q:GMRCDR="" ;alb/sat 86 do not include if DATE OF REQUEST is not defined
  1. S CHK=$$REQCHK(GMRCDA1)
  1. S:(CHK=0)&(GMRCDR'="") ^GMR(123,"AG",GMRCDR,GMRCDA1)=""
  1. K:(+CHK)&(GMRCDR'="") ^GMR(123,"AG",GMRCDR,GMRCDA1)
  1. Q
  1. ;
  1. REQCHK(GMRCID) ;check activities to determine if the REQUEST/CONSULTATION entry is still active and not scheduled
  1. N GMRCCAN,GMRCCANF,GMRCDC,GMRCDONE,GMRCES,GMRCESF,GMRCNOD,GMRCPDC,GMRC40,GMRCACT,GMRCRPA,GMRCSCH,GMRCSCHF,GMRCSER,GMRCST,GMRCSTF
  1. N GMRCCS,GMRCFD,GMRCPA
  1. N GMRCNOS,X,X1,X2 ;alb/sat 86
  1. S GMRCPA=$O(^ORD(100.01,"B","ACTIVE",0))
  1. S GMRCPDC=$O(^ORD(100.01,"B","DISCONTINUED",0))
  1. S GMRCCS=$$GET1^DIQ(123,GMRCID_",",8,"I")
  1. Q:GMRCCS=GMRCPDC 1 ;don't return this entry if CPRS STATUS is DISCONTINUED
  1. ;Q:$$GET1^DIQ(123,GMRCID_",",8,"I")=GMRCPDC 1 ;don't include this entry if CPRS STATUS is DISCONTINUED ;alb/sat 86 removed redundant check
  1. S GMRCFD=$P($$GET1^DIQ(123,GMRCID_",",.01,"I"),".",1) ;alb/sat 86 - get FILE ENTRY DATE
  1. Q:$$FMADD^XLFDT(DT,-365)>GMRCFD 1 ;alb/sat 86 - do not include records with FILE ENTRY DATE older than 1 year
  1. S GMRCSCH=$$GETIEN("SCHEDULED")
  1. S GMRCST=$$GETIEN("STATUS CHANGE")
  1. S GMRCCAN=$$GETIEN("CANCELLED")
  1. S GMRCDONE=$$GETIEN("COMPLETE/UPDATE")
  1. S GMRCDC=$$GETIEN("DISCONTINUED")
  1. S GMRCES=$$GETIEN("EDIT/RESUBMITTED")
  1. S GMRCNOD=$G(^GMR(123,GMRCID,0))
  1. S GMRCSER=$P(GMRCNOD,U,5)
  1. S DFN=$P(GMRCNOD,U,2)
  1. S (GMRCCANF,GMRCESF,GMRCSCHF,GMRCSTF)=0
  1. ;alb/sat 86 - start modification
  1. I GMRCCS=13 D G REQCHKX ;cancel/no-show ;13 is cancel - see A+7^SDCNSLT SD*5.3*627
  1. .S GMRCCANF=1
  1. .S GMRCNOS=$O(^GMR(123,GMRCID,40,":"),-1) Q:'+GMRCNOS ;ICR 6185
  1. .S GMRCNOS=$O(^GMR(123,GMRCID,40,GMRCNOS),-1) Q:'+GMRCNOS
  1. .S X2=$P($G(^GMR(123,GMRCID,40,GMRCNOS,0)),U),X1=DT D ^%DTC Q:X'=""&(X>180) ;ICR 6185
  1. .I $$FINDTXT(GMRCID,GMRCNOS) D
  1. ..S GMRCCANF=0
  1. ;alb/sat 86 - end modification
  1. ;GMRCESF - if 1 we have determined this request should be returned (return 0)
  1. S GMRCRPA=9999999 F S GMRCRPA=$O(^GMR(123,GMRCID,40,GMRCRPA),-1) Q:GMRCRPA'>0 D Q:GMRCCANF=1 Q:GMRCSCHF=1 Q:GMRCESF=1
  1. .S GMRC40=$G(^GMR(123,GMRCID,40,GMRCRPA,0))
  1. .S GMRCACT=$P(GMRC40,U,2) ;ACTIVITY field 1
  1. .I GMRCACT'=GMRCSCH,GMRCACT'=GMRCST,GMRCACT'=GMRCCAN,GMRCACT'=GMRCDONE,GMRCACT'=GMRCDC,GMRCACT'=GMRCES Q ;only watch the ones we need
  1. .I GMRCACT=GMRCCAN!(GMRCACT=GMRCDONE)!(GMRCACT=GMRCDC) S GMRCCANF=1 Q ;skip completed consults/mgh
  1. .I GMRCACT=GMRCES S GMRCESF=1 Q
  1. .I GMRCACT=GMRCSCH,GMRCSTF=1 S GMRCESF=1 Q
  1. .I GMRCACT=GMRCSCH,GMRCSTF'=1,$$SCHED(DFN,$P(GMRC40,U,3),GMRCSER) S GMRCSCHF=1 Q
  1. .;I GMRCACT=GMRCST,$$FINDTXT(GMRCID,GMRCRPA) S GMRCSTF=1
  1. .I GMRCACT=GMRCST,GMRCCS=GMRCPA S GMRCSTF=1
  1. REQCHKX ; exit ;alb/sat 86 - add REQCHKX tag
  1. Q:GMRCSCHF GMRCSCHF
  1. Q:GMRCCANF GMRCCANF
  1. Q:GMRCESF 0
  1. Q 0
  1. ;
  1. GETIEN(GMRCNM) ;get ID from REQUEST ACTION TYPES file 123.1
  1. N Y
  1. S Y=$O(^GMR(123.1,"B",GMRCNM,0))
  1. Q Y
  1. ;
  1. SCHED(DFN,GMRCDT,GMRCSVC) ;look for appointment with stop code matching one in REQUEST SERVICES
  1. ;INPUT:
  1. ; DFN - patient ID pointer to PATIENT file
  1. ; GMRCDT - actual activity date in FM format
  1. ; GMRCSVC - request services ID pointer to REQUEST SERVICES file 123.5
  1. ;RETURN:
  1. ; 0 = no appointment found with matching stop code
  1. ; 1 = appointment found with matching stop code
  1. ;Q 1 ;do not check for match for now
  1. N GMRCAPI,GMRCARR,GMRCI,GMRCJ,GMRCRET,GMRCSTP,GMRCSTPL
  1. S GMRCRET=0
  1. S GMRCSVC=$G(GMRCSVC)
  1. Q:GMRCSVC="" 0
  1. S GMRCDT=$P($G(GMRCDT),".",1)
  1. I GMRCDT'?7N S GMRCDT=1000103
  1. S GMRCI=0 F S GMRCI=$O(^GMR(123.5,GMRCSVC,688,GMRCI)) Q:GMRCI'>0 D
  1. .S GMRCSTPL(+$P($G(^GMR(123.5,GMRCSVC,688,GMRCI,0)),U,1))=""
  1. K ^TMP($J,"SDAMA301"),GMRCARR
  1. S GMRCARR(1)=$P($$FMADD^XLFDT(GMRCDT,-1),".",1)_";" ;go back 1 day and look forward for appt with matching stop code
  1. S GMRCARR(4)=DFN
  1. S GMRCARR("FLDS")="2;13"
  1. S GMRCAPI=$$SDAPI^SDAMA301(.GMRCARR)
  1. ;GMRCI - pointer to file 44; GMRCJ - appt date/time
  1. S GMRCI=0 F S GMRCI=$O(^TMP($J,"SDAMA301",DFN,GMRCI)) Q:GMRCI'>0 D Q:+GMRCRET
  1. .S GMRCJ=0 F S GMRCJ=$O(^TMP($J,"SDAMA301",DFN,GMRCI,GMRCJ)) Q:GMRCJ'>0 D Q:+GMRCRET
  1. ..S GMRCSTP=+$P($G(^TMP($J,"SDAMA301",DFN,GMRCI,GMRCJ)),U,13)
  1. ..I $P($G(^TMP($J,"SDAMA301",DFN,GMRCI,GMRCJ)),U,25)="",$D(GMRCSTPL(+GMRCSTP)) S GMRCRET=1 ;alb/sat 86
  1. ..;S:$D(GMRCSTPL(+GMRCSTP)) GMRCRET=1
  1. K ^TMP($J,"SDAMA301"),GMRCARR
  1. Q GMRCRET
  1. ;
  1. FINDTXT(GMRCID,GMRCRPA,GMRCTXT) ;find text in word processing field ;alb/sat 86 - removed unused 3rd parameter
  1. ;INPUT:
  1. ; GMRCID - Pointer to REQUEST/CONSULTATION file
  1. ; GMRCRPA - Pointer to REQUEST PROCESSING ACTIVITY in REQUEST/CONSULTATION file
  1. ;RETURN:
  1. ; 1=Text Fount; 0=Not Found
  1. ;alb/sat 86 begin modification
  1. N GMRCI,GMRCJ,GMRCLINE,GMRCMSG,GMRCPREV,GMRCRET,GMRCTHIS,GMRCWP,X
  1. S (GMRCTHIS,GMRCPREV)=""
  1. S GMRCRET=0
  1. S GMRCTXT=$G(GMRCTXT) S:GMRCTXT'="" GMRCTXT=$$UP^XLFSTR(GMRCTXT) ;alb/sat 86
  1. K GMRCWP S X=$$GET1^DIQ(123.02,GMRCRPA_","_GMRCID_",",5,"","GMRCWP","GMRCMSG") ;ICR 6185
  1. S GMRCI=0 F S GMRCI=$O(GMRCWP(GMRCI)) Q:GMRCI="" D Q:GMRCRET=1
  1. .S GMRCTHIS=GMRCWP(GMRCI)
  1. .S GMRCLINE=$$UP^XLFSTR(GMRCPREV_GMRCTHIS)
  1. .I GMRCTXT'="" S:GMRCLINE[GMRCTXT GMRCRET=1 Q
  1. .F GMRCJ=1:1 S GMRCTXT=$P($T(GMRCTXT+GMRCJ),";;",2) Q:GMRCTXT="" D Q:GMRCRET=1
  1. ..S:GMRCLINE[GMRCTXT GMRCRET=1
  1. .;alb/sat 86 end modification
  1. .S GMRCPREV=GMRCTHIS ;keep 'this' line for next iteration in case the phrase wraps around onto 2 lines
  1. Q GMRCRET
  1. ;
  1. ;alb/sat 86
  1. GMRCTXT ;
  1. ;;CANCEL
  1. ;;NOSHOW
  1. ;;NO-SHOW
  1. ;;NO SHOW
  1. ;
  1. ;
  1. POST ;post install for GMRC*3*86
  1. D XREF
  1. Q
  1. XREF ;create and build NEW style AG for all REQUEST/CONSULTATION entries in file 123
  1. N GMRCXR,GMRCRES,GMRCOUT
  1. S GMRCXR("FILE")=123
  1. S GMRCXR("NAME")="AG"
  1. S GMRCXR("SHORT DESCR")="Index of active REQUEST/CONSULTs with no appointment scheduled."
  1. S GMRCXR("TYPE")="M"
  1. S GMRCXR("EXECUTION")="F"
  1. S GMRCXR("ACTIVITY")="IR"
  1. S GMRCXR("ROOT TYPE")="W"
  1. S GMRCXR("ROOT FILE")=123.02
  1. S GMRCXR("USE")="S"
  1. S GMRCXR("DESCR",1)="This cross reference contains entries of the REQUEST/CONSULTATION file"
  1. S GMRCXR("DESCR",2)="that do not have an appointment scheduled."
  1. S GMRCXR("DESCR",3)="This is determined based on the content and order of the entries in"
  1. S GMRCXR("DESCR",4)="the REQUEST PROCESSING ACTIVITY multiple field 40. This cross"
  1. S GMRCXR("DESCR",5)="reference will be updated with any update to the ACTIVITY field under"
  1. S GMRCXR("DESCR",6)="the REQUEST PROCESSING ACTIVITY multiple and that update will be"
  1. S GMRCXR("DESCR",7)="determined based on all REQUEST PROCESSING ACTIVITY entries."
  1. S GMRCXR("DESCR",8)="This cross reference was added in GMRC*3.0*83."
  1. S GMRCXR("SET")="D AG123S1^GMRCXR(DA(1),X)"
  1. S GMRCXR("KILL")="D AG123S1^GMRCXR(DA(1),X)"
  1. S GMRCXR("WHOLE KILL")="K ^GMR(123,""AG"")"
  1. S GMRCXR("VAL",1)="S X=+$P($G(^GMR(123,DA(1),0)),U,7)"
  1. S GMRCXR("VAL",1,"TYP")="C"
  1. S GMRCXR("VAL",1,"SUBSCRIPT")=1
  1. S GMRCXR("VAL",1,"COLLATION")="F"
  1. D CREIXN^DDMOD(.GMRCXR,"S",.GMRCRES,"GMRCOUT")
  1. Q
  1. ;
  1. ;
  1. POST169 ;post install for GMRC*3*169
  1. D AIFC
  1. Q
  1. AIFC ;create and build NEW style AIFC for all REQUEST/CONSULTATION entries in file 123
  1. ;;Built with DIKCBLD
  1. N GMRCXR,GMRCRES,GMRCOUT
  1. S GMRCXR("FILE")=123
  1. S GMRCXR("NAME")="AIFC"
  1. S GMRCXR("TYPE")="R"
  1. S GMRCXR("USE")="S"
  1. S GMRCXR("DESCR",1)="This cross reference is used to look up IFC, process actions on IFC, and process IFC HL7."
  1. S GMRCXR("EXECUTION")="R"
  1. S GMRCXR("ACTIVITY")="IR"
  1. S GMRCXR("SHORT DESCR")="Index on ROUTING FACILITY & REMOTE CONSULT #"
  1. S GMRCXR("VAL",1)=.07
  1. S GMRCXR("VAL",1,"SUBSCRIPT")=1
  1. S GMRCXR("VAL",1,"LENGTH")=5
  1. S GMRCXR("VAL",1,"COLLATION")="F"
  1. S GMRCXR("VAL",2)=.06
  1. S GMRCXR("VAL",2,"SUBSCRIPT")=2
  1. S GMRCXR("VAL",2,"LENGTH")=20 ;modified to correct field length - was 9 ; changed 12 to 20 *189 wtc 5/25/2023
  1. S GMRCXR("VAL",2,"COLLATION")="F"
  1. D CREIXN^DDMOD(.GMRCXR,"SW",.GMRCRES,"GMRCOUT")
  1. Q
  1. ;
  1. POST189 ; post=install for GMRC*3*189
  1. D AIFC Q ;
  1. ;