GMRCIAIT ;SLC/JFR - PRINT ALL INC. IFC TRANSACTIONS; 12/18/02 09:11
;;3.0;CONSULT/REQUEST TRACKING;**30**;DEC 27, 1997
EN ; get the device to use
N %ZIS,POP
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="RPT^GMRCIAIT",ZTDESC="Incomplete IFC Transaction report"
. S ZTIO=ION,ZTDTH=$H
. D ^%ZTLOAD
. I $G(ZTSK) W !,"Queued to Print, Task # ",ZTSK
. E W !,"Sorry, Try again Later"
D RPT
D ^%ZISC,HOME^%ZIS
Q
RPT ; sort logic
I $D(ZTQUEUED) S ZTREQ="@"
U IO
N GMRCDA,GMRCPAGE,GMRCQT
S GMRCDA=0,GMRCPAGE=1
I '$O(^GMR(123.6,"AC",GMRCDA)) D HDR(.GMRCPAGE),NOREC Q
D HDR(.GMRCPAGE)
F S GMRCDA=$O(^GMR(123.6,"AC",GMRCDA)) Q:'GMRCDA!($D(GMRCQT)) D
. I $Y>(IOSL-9) D Q:$D(GMRCQT)
.. N DIR,DIRUT,DIROUT,DUOUT,DTOUT
.. ;W !
.. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR
.. I $D(DIRUT) S GMRCQT=1 Q
.. D HDR(.GMRCPAGE)
. W !!,?11,"CONSULT/REQUEST #: ",GMRCDA
. N GMRCACT,GMRCLOG
. S GMRCACT=0
. F S GMRCACT=$O(^GMR(123.6,"AC",GMRCDA,GMRCACT)) Q:'GMRCACT!($D(GMRCQT)) D
.. S GMRCLOG=$O(^GMR(123.6,"AC",GMRCDA,GMRCACT,1,0)) Q:'GMRCLOG
.. I $Y>(IOSL-8) D Q:$D(GMRCQT)
... N DIR,DIRUT,DIROUT,DUOUT,DTOUT
... ;W !
... I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR
... I $D(DIRUT) S GMRCQT=1 Q
... D HDR(.GMRCPAGE)
.. D PRTLOG(GMRCLOG,GMRCDA,GMRCACT)
.. Q
. Q
Q
PRTLOG(LOG,CSLT,ACTVT) ;print the formatted entry
;
; Input:
; LOG = ien from file 123.6
; CSLT = ien from file 123 associated with LOG
; ACTVT = activity within CSLT that is incomplete
;
N GMRCMSG,GMRCPT,GMRCSSN,GMRCERR,GMRCDT
N GMRCFAC,GMRCSER,GMRCTRAN,GMRCLOG0,GMRCDTR
S GMRCLOG0=$G(^GMR(123.6,LOG,0)) I '$L(GMRCLOG0) Q
S GMRCDT=$$FMTE^XLFDT($P(GMRCLOG0,U),2)
S GMRCFAC=$$GET1^DIQ(4,$P(GMRCLOG0,U,2),.01)
S GMRCMSG=$P(GMRCLOG0,U,3)
S GMRCTRAN=$P(GMRCLOG0,U,7)
S GMRCERR=$$GET1^DIQ(123.6,LOG,.08)
S GMRCSER=$$GET1^DIQ(123,CSLT,1)
S GMRCPT=$$GET1^DIQ(123,CSLT,.02,"I")
S GMRCDTR=$$FMTE^XLFDT($$GET1^DIQ(123,CSLT,.01,"I"),2)
S GMRCSSN=$$GET1^DIQ(2,GMRCPT,.09)
S GMRCPT=$$GET1^DIQ(2,GMRCPT,.01)
W !!,?2,"Date/Time last transmitted: ",GMRCDT
W ?51,"Trans. attempts: ",GMRCTRAN
W !,?2,"Facility: ",GMRCFAC,?51,"Message: ",GMRCMSG
W !,?2,"Consult #: ",CSLT,?51,"Activity: ",ACTVT
W !,?2,"Patient name: ",GMRCPT,?51,"SSN: ",GMRCSSN
W !,?2,"Ordered Service: ",$E(GMRCSER,1,31),?51,"Req. date: ",GMRCDTR
W !,?2,"Error: ",GMRCERR
Q
NOREC ; print the no records found message
W !,?5,"No incomplete IFC Transactions to report",!
Q
HDR(PAGE) ; print the page hdr and increment page number
;
W @IOF
W "Incomplete IFC Transaction Report"
W ?44,$$FMTE^XLFDT($$NOW^XLFDT),?69,"Page: ",PAGE
W !,$$REPEAT^XLFSTR("-",78)
S PAGE=PAGE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCIAIT 2805 printed Sep 23, 2025@19:21:57 Page 2
GMRCIAIT ;SLC/JFR - PRINT ALL INC. IFC TRANSACTIONS; 12/18/02 09:11
+1 ;;3.0;CONSULT/REQUEST TRACKING;**30**;DEC 27, 1997
EN ; get the device to use
+1 NEW %ZIS,POP
+2 SET %ZIS="QM"
DO ^%ZIS
+3 IF POP
DO HOME^%ZIS
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 NEW ZTRTN,ZTSK,ZTIO,ZTDTH,ZTDESC
+6 SET ZTRTN="RPT^GMRCIAIT"
SET ZTDESC="Incomplete IFC Transaction report"
+7 SET ZTIO=ION
SET ZTDTH=$HOROLOG
+8 DO ^%ZTLOAD
+9 IF $GET(ZTSK)
WRITE !,"Queued to Print, Task # ",ZTSK
+10 IF '$TEST
WRITE !,"Sorry, Try again Later"
End DoDot:1
DO ^%ZISC
DO HOME^%ZIS
QUIT
+11 DO RPT
+12 DO ^%ZISC
DO HOME^%ZIS
+13 QUIT
RPT ; sort logic
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 USE IO
+3 NEW GMRCDA,GMRCPAGE,GMRCQT
+4 SET GMRCDA=0
SET GMRCPAGE=1
+5 IF '$ORDER(^GMR(123.6,"AC",GMRCDA))
DO HDR(.GMRCPAGE)
DO NOREC
QUIT
+6 DO HDR(.GMRCPAGE)
+7 FOR
SET GMRCDA=$ORDER(^GMR(123.6,"AC",GMRCDA))
if 'GMRCDA!($DATA(GMRCQT))
QUIT
Begin DoDot:1
+8 IF $Y>(IOSL-9)
Begin DoDot:2
+9 NEW DIR,DIRUT,DIROUT,DUOUT,DTOUT
+10 ;W !
+11 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
+12 IF $DATA(DIRUT)
SET GMRCQT=1
QUIT
+13 DO HDR(.GMRCPAGE)
End DoDot:2
if $DATA(GMRCQT)
QUIT
+14 WRITE !!,?11,"CONSULT/REQUEST #: ",GMRCDA
+15 NEW GMRCACT,GMRCLOG
+16 SET GMRCACT=0
+17 FOR
SET GMRCACT=$ORDER(^GMR(123.6,"AC",GMRCDA,GMRCACT))
if 'GMRCACT!($DATA(GMRCQT))
QUIT
Begin DoDot:2
+18 SET GMRCLOG=$ORDER(^GMR(123.6,"AC",GMRCDA,GMRCACT,1,0))
if 'GMRCLOG
QUIT
+19 IF $Y>(IOSL-8)
Begin DoDot:3
+20 NEW DIR,DIRUT,DIROUT,DUOUT,DTOUT
+21 ;W !
+22 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
+23 IF $DATA(DIRUT)
SET GMRCQT=1
QUIT
+24 DO HDR(.GMRCPAGE)
End DoDot:3
if $DATA(GMRCQT)
QUIT
+25 DO PRTLOG(GMRCLOG,GMRCDA,GMRCACT)
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 QUIT
PRTLOG(LOG,CSLT,ACTVT) ;print the formatted entry
+1 ;
+2 ; Input:
+3 ; LOG = ien from file 123.6
+4 ; CSLT = ien from file 123 associated with LOG
+5 ; ACTVT = activity within CSLT that is incomplete
+6 ;
+7 NEW GMRCMSG,GMRCPT,GMRCSSN,GMRCERR,GMRCDT
+8 NEW GMRCFAC,GMRCSER,GMRCTRAN,GMRCLOG0,GMRCDTR
+9 SET GMRCLOG0=$GET(^GMR(123.6,LOG,0))
IF '$LENGTH(GMRCLOG0)
QUIT
+10 SET GMRCDT=$$FMTE^XLFDT($PIECE(GMRCLOG0,U),2)
+11 SET GMRCFAC=$$GET1^DIQ(4,$PIECE(GMRCLOG0,U,2),.01)
+12 SET GMRCMSG=$PIECE(GMRCLOG0,U,3)
+13 SET GMRCTRAN=$PIECE(GMRCLOG0,U,7)
+14 SET GMRCERR=$$GET1^DIQ(123.6,LOG,.08)
+15 SET GMRCSER=$$GET1^DIQ(123,CSLT,1)
+16 SET GMRCPT=$$GET1^DIQ(123,CSLT,.02,"I")
+17 SET GMRCDTR=$$FMTE^XLFDT($$GET1^DIQ(123,CSLT,.01,"I"),2)
+18 SET GMRCSSN=$$GET1^DIQ(2,GMRCPT,.09)
+19 SET GMRCPT=$$GET1^DIQ(2,GMRCPT,.01)
+20 WRITE !!,?2,"Date/Time last transmitted: ",GMRCDT
+21 WRITE ?51,"Trans. attempts: ",GMRCTRAN
+22 WRITE !,?2,"Facility: ",GMRCFAC,?51,"Message: ",GMRCMSG
+23 WRITE !,?2,"Consult #: ",CSLT,?51,"Activity: ",ACTVT
+24 WRITE !,?2,"Patient name: ",GMRCPT,?51,"SSN: ",GMRCSSN
+25 WRITE !,?2,"Ordered Service: ",$EXTRACT(GMRCSER,1,31),?51,"Req. date: ",GMRCDTR
+26 WRITE !,?2,"Error: ",GMRCERR
+27 QUIT
NOREC ; print the no records found message
+1 WRITE !,?5,"No incomplete IFC Transactions to report",!
+2 QUIT
HDR(PAGE) ; print the page hdr and increment page number
+1 ;
+2 WRITE @IOF
+3 WRITE "Incomplete IFC Transaction Report"
+4 WRITE ?44,$$FMTE^XLFDT($$NOW^XLFDT),?69,"Page: ",PAGE
+5 WRITE !,$$REPEAT^XLFSTR("-",78)
+6 SET PAGE=PAGE+1
+7 QUIT
