RGMTHLPD ;BIR/CML-MPI/PD HL7 MESSAGE STATUS REPORT (DETAILED) ;12/12/00
;;1.0;CLINICAL INFO RESOURCE NETWORK;**21**;30 Apr 99
;
;Reference to ^HL(771.6 supported by IA #2507
;Reference to ^HL(772 supported by IA #3464
;Reference to ^HLCS(870 supported by IA #2525
;Reference to ^HLMA( supported by IA #3273
;Reference to ^ORD(101 supported by IA #2596
;
BEGIN ; Produce DETAILED Report
W !!,"This option allows you to print information found during the ""Compile MPI/PD"
W !,"HL7 Data"" compilation. The report is sorted by RELATED EVENT PROTOCOL, date,"
W !,"transmission type, and status. Detailed information for each HL7 message is"
W !,"displayed."
;
PROT ;Ask for all or single PROTCOL
K DIR,DIRUT,DTOUT,DUOUT,REPNM
W !! S DIR(0)="SAM^A:ALL Protocols;S:Single Protocol;"
S DIR("A")="Do you want (A)ll or a (S)ingle Protocol: "
D ^DIR K DIR G:$D(DIRUT) QUIT I Y="A" G ASK1
S DIC="^ORD(101,",DIC(0)="QEAM"
S DIC("S")="S ORD=$P(^(0),""^"") I $D(^XTMP(""RGMT"",""HL"",ORD))"
D ^DIC K DIC G:Y<0 QUIT
S PROT=+Y,REPNM=$P(Y,"^",2)
;
ASK1 ;Ask for Date Range
W !!,"Enter date range for data to be included in report."
K DIR,DIRUT,DTOUT,DUOUT
S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date for Report: "
D ^DIR K DIR G:$D(DIRUT) QUIT
S RGBDT=Y,DIR(0)="DAO^"_RGBDT_":DT:EPX"
S DIR("A")="Ending Date for Report: "
D ^DIR K DIR G:$D(DIRUT) QUIT S RGEDT=Y
;
DEV ;
W !!,"The right margin for this report is 132.",!!
S ZTSAVE("RGBDT")="",ZTSAVE("RGEDT")="",ZTSAVE("REPNM")=""
D EN^XUTMDEVQ("START^RGMTHLPD","MPI/PD - Print HL7 Message Status (DETAILED)") I 'POP Q
W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
G QUIT
;
START ;Print report
S (PG,QFLG)=0,U="^",$P(LN,"-",132)="",SITE=$P($$SITE^VASITE(),U,2)
S PRGBDT=$$FMTE^XLFDT(RGBDT),PRGEDT=$$FMTE^XLFDT(RGEDT)
D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
D HDR
I $D(REPNM) W !!,REPNM,":" D LOOP G QUIT
S REPNM="@@@@"
F S REPNM=$O(^XTMP("RGMT","HL",REPNM)) Q:REPNM="" Q:QFLG D
.D:$Y+3>IOSL HDR Q:QFLG
.W !!,REPNM,":" D LOOP
;
QUIT ;
I $E(IOST)="C"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
.S SS=22-$Y F JJ=1:1:SS W !
K %,CNT,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,HDT,HLMADTPR,HLMAICN,HLMALINK,HLMALL,HLMAPROT,HLMASTAT,ICN,IEN
K IEN0,JJ,LN,PG,PRGBDT,PRGEDT,PROCDT,PROT,PTNM,QFLG,REP,REPNM,RGBDT,RGDT,RGEDT,SITE,SS,STAT
K STATNM,STOPDT,TXT,TYPE,X,Y,ZTSK
W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
;
LOOP ;
S STOPDT=RGEDT_".9",CNT=0
S RGDT=RGBDT-.1
F S RGDT=$O(^XTMP("RGMT","HL",REPNM,RGDT)) Q:'RGDT Q:RGDT>STOPDT Q:QFLG D
.D:$Y+4>IOSL HDR Q:QFLG
.S TYPE=""
.F S TYPE=$O(^XTMP("RGMT","HL",REPNM,RGDT,TYPE)) Q:TYPE="" Q:QFLG D
..S STAT=""
..F S STAT=$O(^XTMP("RGMT","HL",REPNM,RGDT,TYPE,STAT)) Q:STAT="" Q:QFLG D
...S IEN=0
...F S IEN=$O(^XTMP("RGMT","HL",REPNM,RGDT,TYPE,STAT,IEN)) Q:'IEN Q:QFLG D
....D:$Y+3>IOSL HDR Q:QFLG S CNT=CNT+1
....W !!?3,$$FMTE^XLFDT($E(RGDT,1,12)),?18,$S(TYPE="O":"OUTGOING",1:"INCOMING"),?29,STAT
....I '$D(^HL(772,IEN,0)) W ?96,"<<PURGED>>" Q
....S PROCDT=$P($G(^HL(772,IEN,"P")),U,2),PROCDT=$$FMTE^XLFDT($E(PROCDT,1,12))
....W ?61,PROCDT,?83,"^HL(772,",IEN
....I REPNM="MPIF CMOR RESULT SERVER"&(TYPE="O") I $D(^HL(772,IEN,"IN",1,0)) D
.....S ICN=+$P(^HL(772,IEN,"IN",1,0),"^",3)
.....S DFN=$$GETDFN^MPIF001(ICN)
.....S PTNM="NO DFN" I DFN S PTNM=$P(^DPT(DFN,0),"^")
.....W !?6,"ICN: ",ICN," NAME: ",PTNM
....S HLMAIEN=0
....F S HLMAIEN=$O(^HLMA("B",IEN,HLMAIEN)) Q:'HLMAIEN Q:QFLG D
.....S HLMASTAT=$P(^HL(771.6,($P(^HLMA(HLMAIEN,"P"),"^")),0),"^")
.....S HLMADTPR="" I $D(^HLMA(HLMAIEN,"S")) S HLMADTPR=$$FMTE^XLFDT($E($P(^HLMA(HLMAIEN,"S"),"^"),1,12))
.....S HLMAPROT=$P(^ORD(101,$P(^HLMA(HLMAIEN,0),"^",8),0),"^")
.....S HLMALL=$P(^HLMA(HLMAIEN,0),"^",7)
.....S HLMALINK=$P(^HLCS(870,HLMALL,0),"^")
.....D:$Y+3>IOSL HDR Q:QFLG
.....W !?6,"=>^HLMA(",HLMAIEN,?29,HLMASTAT,?61,HLMADTPR,?83,HLMAPROT,?116,HLMALINK
W !!?110,"TOTAL: ",CNT
Q
;
HDR ;HEADER
I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
S PG=PG+1 W:$Y!($E(IOST)="C") @IOF
W !,"MPI/PD HL7 MESSAGE STATUS REPORT - DETAILED (",PRGBDT," to ",PRGEDT,")"
W ?117,"Page: ",PG,!,"Printed at ",SITE," on ",HDT
W !!,"RELATED EVENT PROTOCOL",!?3,"DATE",?18,"TYPE",?29,"STATUS IN FILE #772"
W ?61,"DATE PROCESSED",?83,"FILE #772 IEN"
W !?6,"=>FILE #773 ENTRY",?29,"STATUS IN FILE #773",?61,"DATE PROCESSED"
W ?83,"PROTOCOL",?116,"LOGICAL LINK",!,LN
Q
;
REPROC ;reprocess entries in xtmp global ^XTMP("REPROC"
S CNT=0
S HLMALINK=""
F S HLMALINK=$O(^XTMP("REPROC",HLMALINK)) Q:HLMALINK="" D
.S HLMAIEN=0
.F S HLMAIEN=$O(^XTMP("REPROC",HLMALINK,HLMAIEN)) Q:'HLMAIEN D
..S CNT=CNT+1
W !!,CNT," messages to attempt to process."
;
S CNT=0
S HLMALINK=""
F S HLMALINK=$O(^XTMP("REPROC",HLMALINK)) Q:HLMALINK="" D
.S HLMAIEN=0
.F S HLMAIEN=$O(^XTMP("REPROC",HLMALINK,HLMAIEN)) Q:'HLMAIEN D
..S RGRTN=$G(^ORD(101,PROT,771))
..I '$$REPROC^HLUTIL(HLMAIEN,RGRTN) S CNT=CNT+1
W !!,CNT," messages successfully processed."
K CNT,HLMALINK,HLMAIEN,RGRTN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTHLPD 5188 printed Sep 23, 2025@19:18:23 Page 2
RGMTHLPD ;BIR/CML-MPI/PD HL7 MESSAGE STATUS REPORT (DETAILED) ;12/12/00
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**21**;30 Apr 99
+2 ;
+3 ;Reference to ^HL(771.6 supported by IA #2507
+4 ;Reference to ^HL(772 supported by IA #3464
+5 ;Reference to ^HLCS(870 supported by IA #2525
+6 ;Reference to ^HLMA( supported by IA #3273
+7 ;Reference to ^ORD(101 supported by IA #2596
+8 ;
BEGIN ; Produce DETAILED Report
+1 WRITE !!,"This option allows you to print information found during the ""Compile MPI/PD"
+2 WRITE !,"HL7 Data"" compilation. The report is sorted by RELATED EVENT PROTOCOL, date,"
+3 WRITE !,"transmission type, and status. Detailed information for each HL7 message is"
+4 WRITE !,"displayed."
+5 ;
PROT ;Ask for all or single PROTCOL
+1 KILL DIR,DIRUT,DTOUT,DUOUT,REPNM
+2 WRITE !!
SET DIR(0)="SAM^A:ALL Protocols;S:Single Protocol;"
+3 SET DIR("A")="Do you want (A)ll or a (S)ingle Protocol: "
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO QUIT
IF Y="A"
GOTO ASK1
+5 SET DIC="^ORD(101,"
SET DIC(0)="QEAM"
+6 SET DIC("S")="S ORD=$P(^(0),""^"") I $D(^XTMP(""RGMT"",""HL"",ORD))"
+7 DO ^DIC
KILL DIC
if Y<0
GOTO QUIT
+8 SET PROT=+Y
SET REPNM=$PIECE(Y,"^",2)
+9 ;
ASK1 ;Ask for Date Range
+1 WRITE !!,"Enter date range for data to be included in report."
+2 KILL DIR,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="DAO^:DT:EPX"
SET DIR("A")="Beginning Date for Report: "
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO QUIT
+5 SET RGBDT=Y
SET DIR(0)="DAO^"_RGBDT_":DT:EPX"
+6 SET DIR("A")="Ending Date for Report: "
+7 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO QUIT
SET RGEDT=Y
+8 ;
DEV ;
+1 WRITE !!,"The right margin for this report is 132.",!!
+2 SET ZTSAVE("RGBDT")=""
SET ZTSAVE("RGEDT")=""
SET ZTSAVE("REPNM")=""
+3 DO EN^XUTMDEVQ("START^RGMTHLPD","MPI/PD - Print HL7 Message Status (DETAILED)")
IF 'POP
QUIT
+4 WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
+5 GOTO QUIT
+6 ;
START ;Print report
+1 SET (PG,QFLG)=0
SET U="^"
SET $PIECE(LN,"-",132)=""
SET SITE=$PIECE($$SITE^VASITE(),U,2)
+2 SET PRGBDT=$$FMTE^XLFDT(RGBDT)
SET PRGEDT=$$FMTE^XLFDT(RGEDT)
+3 DO NOW^%DTC
SET HDT=$$FMTE^XLFDT($EXTRACT(%,1,12))
+4 DO HDR
+5 IF $DATA(REPNM)
WRITE !!,REPNM,":"
DO LOOP
GOTO QUIT
+6 SET REPNM="@@@@"
+7 FOR
SET REPNM=$ORDER(^XTMP("RGMT","HL",REPNM))
if REPNM=""
QUIT
if QFLG
QUIT
Begin DoDot:1
+8 if $Y+3>IOSL
DO HDR
if QFLG
QUIT
+9 WRITE !!,REPNM,":"
DO LOOP
End DoDot:1
+10 ;
QUIT ;
+1 IF $EXTRACT(IOST)="C"&('QFLG)
SET DIR(0)="E"
Begin DoDot:1
+2 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
End DoDot:1
DO ^DIR
KILL DIR
+3 KILL %,CNT,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,HDT,HLMADTPR,HLMAICN,HLMALINK,HLMALL,HLMAPROT,HLMASTAT,ICN,IEN
+4 KILL IEN0,JJ,LN,PG,PRGBDT,PRGEDT,PROCDT,PROT,PTNM,QFLG,REP,REPNM,RGBDT,RGDT,RGEDT,SITE,SS,STAT
+5 KILL STATNM,STOPDT,TXT,TYPE,X,Y,ZTSK
+6 if $EXTRACT(IOST)'="C"
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+7 ;
LOOP ;
+1 SET STOPDT=RGEDT_".9"
SET CNT=0
+2 SET RGDT=RGBDT-.1
+3 FOR
SET RGDT=$ORDER(^XTMP("RGMT","HL",REPNM,RGDT))
if 'RGDT
QUIT
if RGDT>STOPDT
QUIT
if QFLG
QUIT
Begin DoDot:1
+4 if $Y+4>IOSL
DO HDR
if QFLG
QUIT
+5 SET TYPE=""
+6 FOR
SET TYPE=$ORDER(^XTMP("RGMT","HL",REPNM,RGDT,TYPE))
if TYPE=""
QUIT
if QFLG
QUIT
Begin DoDot:2
+7 SET STAT=""
+8 FOR
SET STAT=$ORDER(^XTMP("RGMT","HL",REPNM,RGDT,TYPE,STAT))
if STAT=""
QUIT
if QFLG
QUIT
Begin DoDot:3
+9 SET IEN=0
+10 FOR
SET IEN=$ORDER(^XTMP("RGMT","HL",REPNM,RGDT,TYPE,STAT,IEN))
if 'IEN
QUIT
if QFLG
QUIT
Begin DoDot:4
+11 if $Y+3>IOSL
DO HDR
if QFLG
QUIT
SET CNT=CNT+1
+12 WRITE !!?3,$$FMTE^XLFDT($EXTRACT(RGDT,1,12)),?18,$SELECT(TYPE="O":"OUTGOING",1:"INCOMING"),?29,STAT
+13 IF '$DATA(^HL(772,IEN,0))
WRITE ?96,"<<PURGED>>"
QUIT
+14 SET PROCDT=$PIECE($GET(^HL(772,IEN,"P")),U,2)
SET PROCDT=$$FMTE^XLFDT($EXTRACT(PROCDT,1,12))
+15 WRITE ?61,PROCDT,?83,"^HL(772,",IEN
+16 IF REPNM="MPIF CMOR RESULT SERVER"&(TYPE="O")
IF $DATA(^HL(772,IEN,"IN",1,0))
Begin DoDot:5
+17 SET ICN=+$PIECE(^HL(772,IEN,"IN",1,0),"^",3)
+18 SET DFN=$$GETDFN^MPIF001(ICN)
+19 SET PTNM="NO DFN"
IF DFN
SET PTNM=$PIECE(^DPT(DFN,0),"^")
+20 WRITE !?6,"ICN: ",ICN," NAME: ",PTNM
End DoDot:5
+21 SET HLMAIEN=0
+22 FOR
SET HLMAIEN=$ORDER(^HLMA("B",IEN,HLMAIEN))
if 'HLMAIEN
QUIT
if QFLG
QUIT
Begin DoDot:5
+23 SET HLMASTAT=$PIECE(^HL(771.6,($PIECE(^HLMA(HLMAIEN,"P"),"^")),0),"^")
+24 SET HLMADTPR=""
IF $DATA(^HLMA(HLMAIEN,"S"))
SET HLMADTPR=$$FMTE^XLFDT($EXTRACT($PIECE(^HLMA(HLMAIEN,"S"),"^"),1,12))
+25 SET HLMAPROT=$PIECE(^ORD(101,$PIECE(^HLMA(HLMAIEN,0),"^",8),0),"^")
+26 SET HLMALL=$PIECE(^HLMA(HLMAIEN,0),"^",7)
+27 SET HLMALINK=$PIECE(^HLCS(870,HLMALL,0),"^")
+28 if $Y+3>IOSL
DO HDR
if QFLG
QUIT
+29 WRITE !?6,"=>^HLMA(",HLMAIEN,?29,HLMASTAT,?61,HLMADTPR,?83,HLMAPROT,?116,HLMALINK
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 WRITE !!?110,"TOTAL: ",CNT
+31 QUIT
+32 ;
HDR ;HEADER
+1 IF $EXTRACT(IOST)="C"
SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+2 IF $EXTRACT(IOST)="C"
IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+3 SET PG=PG+1
if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
+4 WRITE !,"MPI/PD HL7 MESSAGE STATUS REPORT - DETAILED (",PRGBDT," to ",PRGEDT,")"
+5 WRITE ?117,"Page: ",PG,!,"Printed at ",SITE," on ",HDT
+6 WRITE !!,"RELATED EVENT PROTOCOL",!?3,"DATE",?18,"TYPE",?29,"STATUS IN FILE #772"
+7 WRITE ?61,"DATE PROCESSED",?83,"FILE #772 IEN"
+8 WRITE !?6,"=>FILE #773 ENTRY",?29,"STATUS IN FILE #773",?61,"DATE PROCESSED"
+9 WRITE ?83,"PROTOCOL",?116,"LOGICAL LINK",!,LN
+10 QUIT
+11 ;
REPROC ;reprocess entries in xtmp global ^XTMP("REPROC"
+1 SET CNT=0
+2 SET HLMALINK=""
+3 FOR
SET HLMALINK=$ORDER(^XTMP("REPROC",HLMALINK))
if HLMALINK=""
QUIT
Begin DoDot:1
+4 SET HLMAIEN=0
+5 FOR
SET HLMAIEN=$ORDER(^XTMP("REPROC",HLMALINK,HLMAIEN))
if 'HLMAIEN
QUIT
Begin DoDot:2
+6 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+7 WRITE !!,CNT," messages to attempt to process."
+8 ;
+9 SET CNT=0
+10 SET HLMALINK=""
+11 FOR
SET HLMALINK=$ORDER(^XTMP("REPROC",HLMALINK))
if HLMALINK=""
QUIT
Begin DoDot:1
+12 SET HLMAIEN=0
+13 FOR
SET HLMAIEN=$ORDER(^XTMP("REPROC",HLMALINK,HLMAIEN))
if 'HLMAIEN
QUIT
Begin DoDot:2
+14 SET RGRTN=$GET(^ORD(101,PROT,771))
+15 IF '$$REPROC^HLUTIL(HLMAIEN,RGRTN)
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+16 WRITE !!,CNT," messages successfully processed."
+17 KILL CNT,HLMALINK,HLMAIEN,RGRTN
+18 QUIT
