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