- 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 Feb 18, 2025@23:12:22 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