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

GMRCICMT.m

Go to the documentation of this file.
  1. GMRCICMT ;SLC/JFR - IFC Possible Erroneous Comments Report; Jan 19,2024@14:05
  1. ;;3.0;CONSULT/REQUEST TRACKING;**193,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 ACTCNT,TOTCNT,ACTTYPE,PTNM,PTSSN,REMSIT,ZTQUEUED,ZTREQ,GIDX,GMRCODT
  1. N %ZIS,POP,IO,GEXIT,NMIDX,GMRCNM
  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^GMRCICMT"_"("_GMBEG_")",ZTDESC="IFC Possible Erroneous Comments 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. 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("GMRCICMT",$J)
  1. D GETIFCS
  1. S TOTCNT=^TMP("GMRCICMT",$J,"TOTCNT")
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. U IO
  1. S TAB=$$REPEAT^XLFSTR(" ",79)
  1. S REMNUM=0,ANS="",GMRCPG=0,ACTCNT=0
  1. ; Loop the ^TMP global of selected IFCs and write records
  1. ; GMRCO = consult internal entry number
  1. ; GMRCDA = activity internal entry number
  1. I '$D(^TMP("GMRCICMT",$J)) S GMBEG="" S TOTCNT=0 D HDR(.GMRCPG),NOREC Q
  1. S GMRCSITE=0
  1. F S GMRCSITE=$O(^TMP("GMRCICMT",$J,GMRCSITE)) Q:('GMRCSITE) D
  1. . S GMRCO=0
  1. . F S GMRCO=$O(^TMP("GMRCICMT",$J,GMRCSITE,+GMRCO)) Q:('GMRCO) D
  1. .. S GMRCDA=0
  1. .. F S GMRCDA=$O(^TMP("GMRCICMT",$J,GMRCSITE,+GMRCO,+GMRCDA)) Q:('GMRCDA) D
  1. ... D RPTACT
  1. ... Q
  1. .. Q
  1. . Q
  1. W !,$$CJ^XLFSTR("End of Report",80),!!
  1. K ^TMP("GMRCICMT",$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("GMRCICMT",$J,GMRCISIT,GMRCO,GMRCACT,0)="" S TOTCNT=TOTCNT+1
  1. ... Q
  1. .. Q
  1. . Q
  1. S ^TMP("GMRCICMT",$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 (ACTCNT#3)=0 D HDR(.GMRCPG)
  1. S ACTCNT=ACTCNT+1
  1. W !,"Possible Erroneous Comment: "_$TR($J(ACTCNT,10)," ")_"/"_$TR($J(TOTCNT,10)," ")
  1. S PTNM="Patient Name: "_$$GET1^DIQ(123,+GMRCO,.02,"E")
  1. S PTSSN="SSN: "_$$GET1^DIQ(2,$P(^GMR(123,+GMRCO,0),U,2),.09)
  1. S REMSIT="Receiving Site: "_$$GET1^DIQ(4,$P(^GMR(123,+GMRCO,0),U,23),.01)
  1. S REMNUM="Remote Consult #: "_$P(^GMR(123,+GMRCO,0),U,22)
  1. W !," "
  1. W !,"Consult #: ",GMRCO
  1. W !,PTNM,$$REPEAT^XLFSTR(" ",51-$L(PTNM)),PTSSN
  1. W !,REMSIT,$$REPEAT^XLFSTR(" ",51-$L(REMSIT)),REMNUM
  1. ; GMRCX/GMRCX2 are scratch pad variables
  1. S GMRCX="Action: "_$P($G(^GMR(123.1,+GMRCTYPE,0)),"^",1)
  1. S:'$L(GMRCX) GMRCX="Action: "_GMRCTYPE
  1. S GMRCX2="Activity #:"_+GMRCDA
  1. W !,GMRCX2,$$REPEAT^XLFSTR(" ",51-$L(GMRCX2)),GMRCX
  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. W !,"TIU Document #: ",GMRCX
  1. W !," "
  1. W !,"Activity Date/Time File Entry Date/Time Service Name"
  1. W !,$$REPEAT^XLFSTR("-",79)
  1. S DASHES=$$REPEAT^XLFSTR("-",79)
  1. ;Add on Date/time of Actual Activity, File Entry Date/Time, and Service Name
  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. W !,GMRCX2_$E(TAB,1,21-$L(GMRCX2))_GMRCODT_$E(TAB,1,22-$L(GMRCODT))_GMRCNM
  1. W !," "
  1. Q
  1. RPTCMTS ;
  1. S GMRCCMT=0,GMRCLINE=""
  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. .. S GMRCLINE=$G(^GMR(123,+GMRCO,40,+GMRCDA,1,GMRCCMT,0))
  1. .. W !,GMRCLINE
  1. W !," "
  1. W !,$$REPEAT^XLFSTR("=",79)
  1. Q
  1. NOREC ; Print the no records found message
  1. W !!,$$CJ^XLFSTR("No IFC possible erroneous comments to report",80),!
  1. Q
  1. HDR(PAGE) ; Print the page hdr and increment page number
  1. ;
  1. S PAGE=PAGE+1
  1. I PAGE>1 W $C(12)
  1. W !,"IFC Possible Erroneous Comments Report"
  1. W ?44,$$FMTE^XLFDT($$NOW^XLFDT),?69,"Page: ",PAGE
  1. W !,$$REPEAT^XLFSTR("-",78)
  1. I PAGE=1 D
  1. . S GMRCX="Total IFC Activities to Review: "_TOTCNT
  1. . W !,$$CJ^XLFSTR(GMRCX,80),!
  1. . W !,$$REPEAT^XLFSTR("*",79)
  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. . W !,$$REPEAT^XLFSTR("*",79),!
  1. . W !,$$REPEAT^XLFSTR("=",79)
  1. Q