GMRCICMX ;SLC/WAS - IFC Possible Erroneous Comments Excel Report; Jan 19, 2024@14:31
;;3.0;CONSULT/REQUEST TRACKING;**199,196**;DEC 27, 1997;Build 3
;
;
Q
EN ; Main
N DASHES,TAB
N GEXIT,GMRCO,GMRCISIT,GMRCRO,GMRCACT,GMRCSITE,GMRCX,GMRCX2,GMRCX3,GMBEG,GIDX
N GMRCDA,GMRCDA0,GMRCDA2,GMRCDA3,GMRCTYPE,GMRCCMT,GMRCLINE,REMNUM,ANS,GMRCPG
N DLM,GACT,GACTDT,GACTENT,GACTNUM,GACTRP,GHDR1,GHDR2,GHDR3,GHDR4,GLINE1,GLINE2,PTID
N ACTCNT,TOTCNT,ACTTYPE,PTNM,PTSSN,REMSIT,ZTQUEUED,ZTREQ,GMRCNM,GMRCODT,RCNT,TIUDOC
N %ZIS,POP,IO,GEXIT,HDRFLG,SVIOM,IOL,NMIDX,GMRCNM,GLENCMT,RPTLEN
S SVIOM=IOM
D BEGDT
S %ZIS="QM" D ^%ZIS
I POP D HOME^%ZIS Q
I $D(IO("Q")) D D ^%ZISC,HOME^%ZIS Q
. N ZTRTN,ZTSK,ZTIO,ZTDTH,ZTDESC
. S ZTRTN="MAKERPT^GMRCICMX"_"("_GMBEG_")",ZTDESC="IFC Possible Erroneous Comments Excel Report"
. S ZTIO=ION,ZTDTH=$H
. D ^%ZTLOAD
. I $G(ZTSK) W !,"Queued to Print, Task # ",ZTSK
. E W !,"Sorry, Try again Later"
I '$D(IO("Q")) D
. D MAKERPT(GMBEG)
. D ^%ZISC,HOME^%ZIS
S IOM=SVIOM
Q
BEGDT ;
N %DT,X,Y
S GEXIT=0,GMBEG=""
W @IOF
W !!,"Enter beginning date for the IFC selection:",!
K %DT
S %DT="AEX"
S %DT("B")="07/01/2020"
S %DT("A")="Beginning Date: "
D ^%DT S GMBEG=+$G(Y)
I Y<1 S GEXIT=1 Q
I GMBEG'>0 D
. S %DT("B")=$$FMTE^XLFDT(GMBEG,"5Z")
W @IOF
Q
MAKERPT(GMBEG) ;
K ^TMP("GMRCICMX",$J)
S IOM=20000
S IOL=999999
S HDRFLG=0
D GETIFCS
I $D(ZTQUEUED) S ZTREQ="@"
U IO
S REMNUM=0,ANS="",GMRCPG=0,ACTCNT=0,DLM="|",RPTLEN=253
; Loop the ^TMP global of selected IFCs and write records
; ^TMP("GMRCICMX",$J,SITE,CSLT,GMRCACT,0)="" <-- Selected IFCs
; GMRCO = consult internal entry number
; GMRCDA = activity internal entry number
I '$D(^TMP("GMRCICMX",$J)) S GMBEG="" S TOTCNT=0 D HDR,NOREC Q
S TOTCNT=^TMP("GMRCICMX",$J,"TOTCNT")
S GMRCSITE=0
F S GMRCSITE=$O(^TMP("GMRCICMX",$J,GMRCSITE)) Q:('GMRCSITE) D
. S GMRCO=0
. F S GMRCO=$O(^TMP("GMRCICMX",$J,GMRCSITE,+GMRCO)) Q:('GMRCO) D
.. S GMRCDA=0
.. F S GMRCDA=$O(^TMP("GMRCICMX",$J,GMRCSITE,+GMRCO,+GMRCDA)) Q:('GMRCDA) D
... D RPTACT
... Q
.. Q
. Q
W !,"End of Report",!
K ^TMP("GMRCICMX",$J)
Q
GETIFCS ; Get IFCs
S GMRCO="",GMRCISIT="",GMRCRO="",TOTCNT=0,ACTCNT=0,GIDX=0
S GMRCISIT=0
F S GMRCISIT=$O(^GMR(123,"AIFC",GMRCISIT)) Q:'GMRCISIT D
. S GMRCRO=0
. F S GMRCRO=$O(^GMR(123,"AIFC",GMRCISIT,GMRCRO)) Q:'GMRCRO D
.. S GMRCO=$O(^GMR(123,"AIFC",GMRCISIT,GMRCRO,0))
.. I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D ACTS
. Q
Q
ACTS ; Get IFC activities
N ERRCMT,CMTIDX,I
S (GMRCACT,CMTIDX,I)=0,ERRCMT=""
F S GMRCACT=$O(^GMR(123,GMRCO,40,GMRCACT)) Q:'GMRCACT D
. S GIDX=GIDX+1 H:'(GIDX#10000) 1
. ; Get only COMPLETE/UPDATE activities
. S ACTTYPE=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)
. Q:ACTTYPE'=10
. ; Do not include any IFCs before the begin date
. S GMRCX=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,1)
. Q:(GMRCX<GMBEG)
. ; Look for associated results or remote associated results to screen out admin completes
. I ($D(^GMR(123,GMRCO,50,"AR")))!($D(^GMR(123,GMRCO,51,"AR"))) D
.. S CMTIDX=0 S CMTIDX=$P($G(^GMR(123,GMRCO,40,GMRCACT,1,0)),U,4) ;p196
.. F I=1:1:CMTIDX S ERRCMT=$S(I=1:$G(^GMR(123,GMRCO,40,GMRCACT,1,I,0)),1:ERRCMT_" "_$G(^GMR(123,GMRCO,40,GMRCACT,1,I,0))) ;p196
.. I CMTIDX>0 D
... I $TR(ERRCMT,"")'="" D
.... S ^TMP("GMRCICMX",$J,GMRCISIT,GMRCO,GMRCACT,0)="" S TOTCNT=TOTCNT+1
... Q
.. Q
. Q
S ^TMP("GMRCICMX",$J,"TOTCNT")=TOTCNT
Q
RPTACT ;
S GMRCACT="",GMRCLINE="",GMRCX="",GMRCX2="",GMRCISIT=0
S TAB=$$REPEAT^XLFSTR(" ",22)
S GMRCODT=$P(^GMR(123,+GMRCO,0),"^",1)
S X=GMRCODT D REGDTM^GMRCU
S GMRCODT=X
S NMIDX=$P(^GMR(123,+GMRCO,0),U,5)
S GMRCNM=$P($G(^GMR(123.5,NMIDX,0)),U,1)
S GMRCDA0=$G(^GMR(123,+GMRCO,40,+GMRCDA,0))
S GMRCTYPE=$P(GMRCDA0,"^",2)
I GMRCTYPE'=10 Q
S GMRCDA2=$G(^GMR(123,+GMRCO,40,+GMRCDA,2))
S GMRCDA3=$G(^GMR(123,+GMRCO,40,+GMRCDA,3))
I $D(^GMR(123,+GMRCO,40,+GMRCDA,2)) D
. S GMRCISIT=$P(^GMR(123,+GMRCO,0),U,23) Q:'GMRCISIT
. S GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01)
; Only reporting if comments exist
D RPTCSLT
D RPTCMTS
Q
RPTCSLT ;
I HDRFLG=0 D HDR
S ACTCNT=ACTCNT+1
S RCNT=$TR($J(ACTCNT,10)," ")_"/"_$TR($J(TOTCNT,10)," ")
S PTNM=$$GET1^DIQ(123,+GMRCO,.02,"E")
S PTSSN=$$GET1^DIQ(2,$P(^GMR(123,+GMRCO,0),U,2),.09)
S PTID=$E(PTNM,1,1)_$E(PTSSN,6,9)
S REMSIT=$$GET1^DIQ(4,$P(^GMR(123,+GMRCO,0),U,23),.01)
S REMNUM=$P(^GMR(123,+GMRCO,0),U,22)
S GACT=$P($G(^GMR(123.1,+GMRCTYPE,0)),"^",1) I $TR(GACT,"")="" S GACT=GMRCTYPE
S GACTNUM=+GMRCDA
S GMRCX="" S GMRCX=$P($O(^GMR(123,+GMRCO,50,"AR",GMRCX)),";",1)
I GMRCX="" S GMRCX=$P($O(^GMR(123,+GMRCO,51,"AR",GMRCX)),";",1)
S TIUDOC=GMRCX
;Date/time of Actual Activity, Who's Responsible for Activity, and Who entered activity
S X=$P(GMRCDA0,"^",3) D REGDTM^GMRCU
S GMRCX2=X_" "_$S($P(GMRCDA2,"^",3)]"":$P(GMRCDA2,"^",3),1:$E(TAB,1,3))
S GMRCX=$S($P(GMRCDA2,"^",2)]"":$E($P(GMRCDA2,"^",2),1,27),$P(GMRCDA0,"^",4):$E($P($G(^VA(200,$P(GMRCDA0,"^",4),0)),"^"),1,27),1:$E(TAB,1,20))
S GMRCX3=$S($P(GMRCDA2,"^")]"":$E($P(GMRCDA2,"^"),1,27),$P(GMRCDA0,"^",5):$E($P($G(^VA(200,$P(GMRCDA0,"^",5),0)),"^"),1,27))
S GACTDT=GMRCX2
S GACTRP=GMRCX
Q
RPTCMTS ;
S GMRCCMT=0,GLENCMT=0,GMRCLINE="",GLINE1="",GLINE2=""
F S GMRCCMT=$O(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT)) Q:'+GMRCCMT D
. I $D(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT,0)) D
.. I GMRCLINE="" S GMRCLINE=$G(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT,0))
.. E S GMRCLINE=GMRCLINE_DLM_$G(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT,0))
I GMRCLINE'="" D
.S GLINE1=RCNT_DLM_GMRCODT_DLM_GMRCNM_DLM_PTID_DLM_REMSIT_DLM_REMNUM_DLM_+GMRCO_DLM_GACTNUM_DLM_TIUDOC_DLM_GACTDT
.S GLENCMT=RPTLEN-$L(GLINE1)
W !,GLINE1_DLM_$E(GMRCLINE,1,GLENCMT)
Q
NOREC ; Print the no records found message
W !!,"No IFC possible erroneous comments to report",!
Q
HDR ; Print the header
;
S HDRFLG=1
S GHDR1="",GHDR2="",GHDR3="",GHDR4=""
W !,"IFC Possible Erroneous Comments Report"
W !,""
S GMRCX="Total IFC Activities to Review: "_TOTCNT
I TOTCNT>0 D
.W !,GMRCX,!
.W !,"No automated modification will be made to inter-facility consults that are "
.W !,"identified with possible erroneous comments at this time.",!
.;
.S GHDR1="Counter"_DLM_"Entry Date/Time"_DLM_"Service Name"_DLM_"PTID"
.S GHDR2="Receiving Site"_DLM_"Remote Consult #"_DLM_"Consult #"_DLM_"Activity #"
.S GHDR3="TIU Document #"_DLM_"Activity Date"_DLM_"Possible Erroneous Comments"
.W !,GHDR1_DLM_GHDR2_DLM_GHDR3
.W !,""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCICMX 6571 printed Oct 16, 2024@17:46:51 Page 2
GMRCICMX ;SLC/WAS - IFC Possible Erroneous Comments Excel Report; Jan 19, 2024@14:31
+1 ;;3.0;CONSULT/REQUEST TRACKING;**199,196**;DEC 27, 1997;Build 3
+2 ;
+3 ;
+4 QUIT
EN ; Main
+1 NEW DASHES,TAB
+2 NEW GEXIT,GMRCO,GMRCISIT,GMRCRO,GMRCACT,GMRCSITE,GMRCX,GMRCX2,GMRCX3,GMBEG,GIDX
+3 NEW GMRCDA,GMRCDA0,GMRCDA2,GMRCDA3,GMRCTYPE,GMRCCMT,GMRCLINE,REMNUM,ANS,GMRCPG
+4 NEW DLM,GACT,GACTDT,GACTENT,GACTNUM,GACTRP,GHDR1,GHDR2,GHDR3,GHDR4,GLINE1,GLINE2,PTID
+5 NEW ACTCNT,TOTCNT,ACTTYPE,PTNM,PTSSN,REMSIT,ZTQUEUED,ZTREQ,GMRCNM,GMRCODT,RCNT,TIUDOC
+6 NEW %ZIS,POP,IO,GEXIT,HDRFLG,SVIOM,IOL,NMIDX,GMRCNM,GLENCMT,RPTLEN
+7 SET SVIOM=IOM
+8 DO BEGDT
+9 SET %ZIS="QM"
DO ^%ZIS
+10 IF POP
DO HOME^%ZIS
QUIT
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 NEW ZTRTN,ZTSK,ZTIO,ZTDTH,ZTDESC
+13 SET ZTRTN="MAKERPT^GMRCICMX"_"("_GMBEG_")"
SET ZTDESC="IFC Possible Erroneous Comments Excel Report"
+14 SET ZTIO=ION
SET ZTDTH=$HOROLOG
+15 DO ^%ZTLOAD
+16 IF $GET(ZTSK)
WRITE !,"Queued to Print, Task # ",ZTSK
+17 IF '$TEST
WRITE !,"Sorry, Try again Later"
End DoDot:1
DO ^%ZISC
DO HOME^%ZIS
QUIT
+18 IF '$DATA(IO("Q"))
Begin DoDot:1
+19 DO MAKERPT(GMBEG)
+20 DO ^%ZISC
DO HOME^%ZIS
End DoDot:1
+21 SET IOM=SVIOM
+22 QUIT
BEGDT ;
+1 NEW %DT,X,Y
+2 SET GEXIT=0
SET GMBEG=""
+3 WRITE @IOF
+4 WRITE !!,"Enter beginning date for the IFC selection:",!
+5 KILL %DT
+6 SET %DT="AEX"
+7 SET %DT("B")="07/01/2020"
+8 SET %DT("A")="Beginning Date: "
+9 DO ^%DT
SET GMBEG=+$GET(Y)
+10 IF Y<1
SET GEXIT=1
QUIT
+11 IF GMBEG'>0
Begin DoDot:1
+12 SET %DT("B")=$$FMTE^XLFDT(GMBEG,"5Z")
End DoDot:1
+13 WRITE @IOF
+14 QUIT
MAKERPT(GMBEG) ;
+1 KILL ^TMP("GMRCICMX",$JOB)
+2 SET IOM=20000
+3 SET IOL=999999
+4 SET HDRFLG=0
+5 DO GETIFCS
+6 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 USE IO
+8 SET REMNUM=0
SET ANS=""
SET GMRCPG=0
SET ACTCNT=0
SET DLM="|"
SET RPTLEN=253
+9 ; Loop the ^TMP global of selected IFCs and write records
+10 ; ^TMP("GMRCICMX",$J,SITE,CSLT,GMRCACT,0)="" <-- Selected IFCs
+11 ; GMRCO = consult internal entry number
+12 ; GMRCDA = activity internal entry number
+13 IF '$DATA(^TMP("GMRCICMX",$JOB))
SET GMBEG=""
SET TOTCNT=0
DO HDR
DO NOREC
QUIT
+14 SET TOTCNT=^TMP("GMRCICMX",$JOB,"TOTCNT")
+15 SET GMRCSITE=0
+16 FOR
SET GMRCSITE=$ORDER(^TMP("GMRCICMX",$JOB,GMRCSITE))
if ('GMRCSITE)
QUIT
Begin DoDot:1
+17 SET GMRCO=0
+18 FOR
SET GMRCO=$ORDER(^TMP("GMRCICMX",$JOB,GMRCSITE,+GMRCO))
if ('GMRCO)
QUIT
Begin DoDot:2
+19 SET GMRCDA=0
+20 FOR
SET GMRCDA=$ORDER(^TMP("GMRCICMX",$JOB,GMRCSITE,+GMRCO,+GMRCDA))
if ('GMRCDA)
QUIT
Begin DoDot:3
+21 DO RPTACT
+22 QUIT
End DoDot:3
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 WRITE !,"End of Report",!
+26 KILL ^TMP("GMRCICMX",$JOB)
+27 QUIT
GETIFCS ; Get IFCs
+1 SET GMRCO=""
SET GMRCISIT=""
SET GMRCRO=""
SET TOTCNT=0
SET ACTCNT=0
SET GIDX=0
+2 SET GMRCISIT=0
+3 FOR
SET GMRCISIT=$ORDER(^GMR(123,"AIFC",GMRCISIT))
if 'GMRCISIT
QUIT
Begin DoDot:1
+4 SET GMRCRO=0
+5 FOR
SET GMRCRO=$ORDER(^GMR(123,"AIFC",GMRCISIT,GMRCRO))
if 'GMRCRO
QUIT
Begin DoDot:2
+6 SET GMRCO=$ORDER(^GMR(123,"AIFC",GMRCISIT,GMRCRO,0))
+7 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
DO ACTS
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
ACTS ; Get IFC activities
+1 NEW ERRCMT,CMTIDX,I
+2 SET (GMRCACT,CMTIDX,I)=0
SET ERRCMT=""
+3 FOR
SET GMRCACT=$ORDER(^GMR(123,GMRCO,40,GMRCACT))
if 'GMRCACT
QUIT
Begin DoDot:1
+4 SET GIDX=GIDX+1
if '(GIDX#10000)
HANG 1
+5 ; Get only COMPLETE/UPDATE activities
+6 SET ACTTYPE=$PIECE(^GMR(123,GMRCO,40,GMRCACT,0),U,2)
+7 if ACTTYPE'=10
QUIT
+8 ; Do not include any IFCs before the begin date
+9 SET GMRCX=$PIECE(^GMR(123,GMRCO,40,GMRCACT,0),U,1)
+10 if (GMRCX<GMBEG)
QUIT
+11 ; Look for associated results or remote associated results to screen out admin completes
+12 IF ($DATA(^GMR(123,GMRCO,50,"AR")))!($DATA(^GMR(123,GMRCO,51,"AR")))
Begin DoDot:2
+13 ;p196
SET CMTIDX=0
SET CMTIDX=$PIECE($GET(^GMR(123,GMRCO,40,GMRCACT,1,0)),U,4)
+14 ;p196
FOR I=1:1:CMTIDX
SET ERRCMT=$SELECT(I=1:$GET(^GMR(123,GMRCO,40,GMRCACT,1,I,0)),1:ERRCMT_" "_$GET(^GMR(123,GMRCO,40,GMRCACT,1,I,0)))
+15 IF CMTIDX>0
Begin DoDot:3
+16 IF $TRANSLATE(ERRCMT,"")'=""
Begin DoDot:4
+17 SET ^TMP("GMRCICMX",$JOB,GMRCISIT,GMRCO,GMRCACT,0)=""
SET TOTCNT=TOTCNT+1
End DoDot:4
+18 QUIT
End DoDot:3
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 SET ^TMP("GMRCICMX",$JOB,"TOTCNT")=TOTCNT
+22 QUIT
RPTACT ;
+1 SET GMRCACT=""
SET GMRCLINE=""
SET GMRCX=""
SET GMRCX2=""
SET GMRCISIT=0
+2 SET TAB=$$REPEAT^XLFSTR(" ",22)
+3 SET GMRCODT=$PIECE(^GMR(123,+GMRCO,0),"^",1)
+4 SET X=GMRCODT
DO REGDTM^GMRCU
+5 SET GMRCODT=X
+6 SET NMIDX=$PIECE(^GMR(123,+GMRCO,0),U,5)
+7 SET GMRCNM=$PIECE($GET(^GMR(123.5,NMIDX,0)),U,1)
+8 SET GMRCDA0=$GET(^GMR(123,+GMRCO,40,+GMRCDA,0))
+9 SET GMRCTYPE=$PIECE(GMRCDA0,"^",2)
+10 IF GMRCTYPE'=10
QUIT
+11 SET GMRCDA2=$GET(^GMR(123,+GMRCO,40,+GMRCDA,2))
+12 SET GMRCDA3=$GET(^GMR(123,+GMRCO,40,+GMRCDA,3))
+13 IF $DATA(^GMR(123,+GMRCO,40,+GMRCDA,2))
Begin DoDot:1
+14 SET GMRCISIT=$PIECE(^GMR(123,+GMRCO,0),U,23)
if 'GMRCISIT
QUIT
+15 SET GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01)
End DoDot:1
+16 ; Only reporting if comments exist
+17 DO RPTCSLT
+18 DO RPTCMTS
+19 QUIT
RPTCSLT ;
+1 IF HDRFLG=0
DO HDR
+2 SET ACTCNT=ACTCNT+1
+3 SET RCNT=$TRANSLATE($JUSTIFY(ACTCNT,10)," ")_"/"_$TRANSLATE($JUSTIFY(TOTCNT,10)," ")
+4 SET PTNM=$$GET1^DIQ(123,+GMRCO,.02,"E")
+5 SET PTSSN=$$GET1^DIQ(2,$PIECE(^GMR(123,+GMRCO,0),U,2),.09)
+6 SET PTID=$EXTRACT(PTNM,1,1)_$EXTRACT(PTSSN,6,9)
+7 SET REMSIT=$$GET1^DIQ(4,$PIECE(^GMR(123,+GMRCO,0),U,23),.01)
+8 SET REMNUM=$PIECE(^GMR(123,+GMRCO,0),U,22)
+9 SET GACT=$PIECE($GET(^GMR(123.1,+GMRCTYPE,0)),"^",1)
IF $TRANSLATE(GACT,"")=""
SET GACT=GMRCTYPE
+10 SET GACTNUM=+GMRCDA
+11 SET GMRCX=""
SET GMRCX=$PIECE($ORDER(^GMR(123,+GMRCO,50,"AR",GMRCX)),";",1)
+12 IF GMRCX=""
SET GMRCX=$PIECE($ORDER(^GMR(123,+GMRCO,51,"AR",GMRCX)),";",1)
+13 SET TIUDOC=GMRCX
+14 ;Date/time of Actual Activity, Who's Responsible for Activity, and Who entered activity
+15 SET X=$PIECE(GMRCDA0,"^",3)
DO REGDTM^GMRCU
+16 SET GMRCX2=X_" "_$SELECT($PIECE(GMRCDA2,"^",3)]"":$PIECE(GMRCDA2,"^",3),1:$EXTRACT(TAB,1,3))
+17 SET GMRCX=$SELECT($PIECE(GMRCDA2,"^",2)]"":$EXTRACT($PIECE(GMRCDA2,"^",2),1,27),$PIECE(GMRCDA0,"^",4):$EXTRACT($PIECE($GET(^VA(200,$PIECE(GMRCDA0,"^",4),0)),"^"),1,27),1:$EXTRACT(TAB,1,20))
+18 SET GMRCX3=$SELECT($PIECE(GMRCDA2,"^")]"":$EXTRACT($PIECE(GMRCDA2,"^"),1,27),$PIECE(GMRCDA0,"^",5):$EXTRACT($PIECE($GET(^VA(200,$PIECE(GMRCDA0,"^",5),0)),"^"),1,27))
+19 SET GACTDT=GMRCX2
+20 SET GACTRP=GMRCX
+21 QUIT
RPTCMTS ;
+1 SET GMRCCMT=0
SET GLENCMT=0
SET GMRCLINE=""
SET GLINE1=""
SET GLINE2=""
+2 FOR
SET GMRCCMT=$ORDER(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT))
if '+GMRCCMT
QUIT
Begin DoDot:1
+3 IF $DATA(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT,0))
Begin DoDot:2
+4 IF GMRCLINE=""
SET GMRCLINE=$GET(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT,0))
+5 IF '$TEST
SET GMRCLINE=GMRCLINE_DLM_$GET(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT,0))
End DoDot:2
End DoDot:1
+6 IF GMRCLINE'=""
Begin DoDot:1
+7 SET GLINE1=RCNT_DLM_GMRCODT_DLM_GMRCNM_DLM_PTID_DLM_REMSIT_DLM_REMNUM_DLM_+GMRCO_DLM_GACTNUM_DLM_TIUDOC_DLM_GACTDT
+8 SET GLENCMT=RPTLEN-$LENGTH(GLINE1)
End DoDot:1
+9 WRITE !,GLINE1_DLM_$EXTRACT(GMRCLINE,1,GLENCMT)
+10 QUIT
NOREC ; Print the no records found message
+1 WRITE !!,"No IFC possible erroneous comments to report",!
+2 QUIT
HDR ; Print the header
+1 ;
+2 SET HDRFLG=1
+3 SET GHDR1=""
SET GHDR2=""
SET GHDR3=""
SET GHDR4=""
+4 WRITE !,"IFC Possible Erroneous Comments Report"
+5 WRITE !,""
+6 SET GMRCX="Total IFC Activities to Review: "_TOTCNT
+7 IF TOTCNT>0
Begin DoDot:1
+8 WRITE !,GMRCX,!
+9 WRITE !,"No automated modification will be made to inter-facility consults that are "
+10 WRITE !,"identified with possible erroneous comments at this time.",!
+11 ;
+12 SET GHDR1="Counter"_DLM_"Entry Date/Time"_DLM_"Service Name"_DLM_"PTID"
+13 SET GHDR2="Receiving Site"_DLM_"Remote Consult #"_DLM_"Consult #"_DLM_"Activity #"
+14 SET GHDR3="TIU Document #"_DLM_"Activity Date"_DLM_"Possible Erroneous Comments"
+15 WRITE !,GHDR1_DLM_GHDR2_DLM_GHDR3
+16 WRITE !,""
End DoDot:1
+17 QUIT
