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

GMRCICMX.m

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