source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTHLPD.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1RGMTHLPD ;BIR/CML-MPI/PD HL7 MESSAGE STATUS REPORT (DETAILED) ;12/12/00
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**21**;30 Apr 99
3 ;
4 ;Reference to ^HL(771.6 supported by IA #2507
5 ;Reference to ^HL(772 supported by IA #3464
6 ;Reference to ^HLCS(870 supported by IA #2525
7 ;Reference to ^HLMA( supported by IA #3273
8 ;Reference to ^ORD(101 supported by IA #2596
9 ;
10BEGIN ; Produce DETAILED Report
11 W !!,"This option allows you to print information found during the ""Compile MPI/PD"
12 W !,"HL7 Data"" compilation. The report is sorted by RELATED EVENT PROTOCOL, date,"
13 W !,"transmission type, and status. Detailed information for each HL7 message is"
14 W !,"displayed."
15 ;
16PROT ;Ask for all or single PROTCOL
17 K DIR,DIRUT,DTOUT,DUOUT,REPNM
18 W !! S DIR(0)="SAM^A:ALL Protocols;S:Single Protocol;"
19 S DIR("A")="Do you want (A)ll or a (S)ingle Protocol: "
20 D ^DIR K DIR G:$D(DIRUT) QUIT I Y="A" G ASK1
21 S DIC="^ORD(101,",DIC(0)="QEAM"
22 S DIC("S")="S ORD=$P(^(0),""^"") I $D(^XTMP(""RGMT"",""HL"",ORD))"
23 D ^DIC K DIC G:Y<0 QUIT
24 S PROT=+Y,REPNM=$P(Y,"^",2)
25 ;
26ASK1 ;Ask for Date Range
27 W !!,"Enter date range for data to be included in report."
28 K DIR,DIRUT,DTOUT,DUOUT
29 S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date for Report: "
30 D ^DIR K DIR G:$D(DIRUT) QUIT
31 S RGBDT=Y,DIR(0)="DAO^"_RGBDT_":DT:EPX"
32 S DIR("A")="Ending Date for Report: "
33 D ^DIR K DIR G:$D(DIRUT) QUIT S RGEDT=Y
34 ;
35DEV ;
36 W !!,"The right margin for this report is 132.",!!
37 S ZTSAVE("RGBDT")="",ZTSAVE("RGEDT")="",ZTSAVE("REPNM")=""
38 D EN^XUTMDEVQ("START^RGMTHLPD","MPI/PD - Print HL7 Message Status (DETAILED)") I 'POP Q
39 W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
40 G QUIT
41 ;
42START ;Print report
43 S (PG,QFLG)=0,U="^",$P(LN,"-",132)="",SITE=$P($$SITE^VASITE(),U,2)
44 S PRGBDT=$$FMTE^XLFDT(RGBDT),PRGEDT=$$FMTE^XLFDT(RGEDT)
45 D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
46 D HDR
47 I $D(REPNM) W !!,REPNM,":" D LOOP G QUIT
48 S REPNM="@@@@"
49 F S REPNM=$O(^XTMP("RGMT","HL",REPNM)) Q:REPNM="" Q:QFLG D
50 .D:$Y+3>IOSL HDR Q:QFLG
51 .W !!,REPNM,":" D LOOP
52 ;
53QUIT ;
54 I $E(IOST)="C"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
55 .S SS=22-$Y F JJ=1:1:SS W !
56 K %,CNT,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,HDT,HLMADTPR,HLMAICN,HLMALINK,HLMALL,HLMAPROT,HLMASTAT,ICN,IEN
57 K IEN0,JJ,LN,PG,PRGBDT,PRGEDT,PROCDT,PROT,PTNM,QFLG,REP,REPNM,RGBDT,RGDT,RGEDT,SITE,SS,STAT
58 K STATNM,STOPDT,TXT,TYPE,X,Y,ZTSK
59 W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
60 ;
61LOOP ;
62 S STOPDT=RGEDT_".9",CNT=0
63 S RGDT=RGBDT-.1
64 F S RGDT=$O(^XTMP("RGMT","HL",REPNM,RGDT)) Q:'RGDT Q:RGDT>STOPDT Q:QFLG D
65 .D:$Y+4>IOSL HDR Q:QFLG
66 .S TYPE=""
67 .F S TYPE=$O(^XTMP("RGMT","HL",REPNM,RGDT,TYPE)) Q:TYPE="" Q:QFLG D
68 ..S STAT=""
69 ..F S STAT=$O(^XTMP("RGMT","HL",REPNM,RGDT,TYPE,STAT)) Q:STAT="" Q:QFLG D
70 ...S IEN=0
71 ...F S IEN=$O(^XTMP("RGMT","HL",REPNM,RGDT,TYPE,STAT,IEN)) Q:'IEN Q:QFLG D
72 ....D:$Y+3>IOSL HDR Q:QFLG S CNT=CNT+1
73 ....W !!?3,$$FMTE^XLFDT($E(RGDT,1,12)),?18,$S(TYPE="O":"OUTGOING",1:"INCOMING"),?29,STAT
74 ....I '$D(^HL(772,IEN,0)) W ?96,"<<PURGED>>" Q
75 ....S PROCDT=$P($G(^HL(772,IEN,"P")),U,2),PROCDT=$$FMTE^XLFDT($E(PROCDT,1,12))
76 ....W ?61,PROCDT,?83,"^HL(772,",IEN
77 ....I REPNM="MPIF CMOR RESULT SERVER"&(TYPE="O") I $D(^HL(772,IEN,"IN",1,0)) D
78 .....S ICN=+$P(^HL(772,IEN,"IN",1,0),"^",3)
79 .....S DFN=$$GETDFN^MPIF001(ICN)
80 .....S PTNM="NO DFN" I DFN S PTNM=$P(^DPT(DFN,0),"^")
81 .....W !?6,"ICN: ",ICN," NAME: ",PTNM
82 ....S HLMAIEN=0
83 ....F S HLMAIEN=$O(^HLMA("B",IEN,HLMAIEN)) Q:'HLMAIEN Q:QFLG D
84 .....S HLMASTAT=$P(^HL(771.6,($P(^HLMA(HLMAIEN,"P"),"^")),0),"^")
85 .....S HLMADTPR="" I $D(^HLMA(HLMAIEN,"S")) S HLMADTPR=$$FMTE^XLFDT($E($P(^HLMA(HLMAIEN,"S"),"^"),1,12))
86 .....S HLMAPROT=$P(^ORD(101,$P(^HLMA(HLMAIEN,0),"^",8),0),"^")
87 .....S HLMALL=$P(^HLMA(HLMAIEN,0),"^",7)
88 .....S HLMALINK=$P(^HLCS(870,HLMALL,0),"^")
89 .....D:$Y+3>IOSL HDR Q:QFLG
90 .....W !?6,"=>^HLMA(",HLMAIEN,?29,HLMASTAT,?61,HLMADTPR,?83,HLMAPROT,?116,HLMALINK
91 W !!?110,"TOTAL: ",CNT
92 Q
93 ;
94HDR ;HEADER
95 I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
96 I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
97 S PG=PG+1 W:$Y!($E(IOST)="C") @IOF
98 W !,"MPI/PD HL7 MESSAGE STATUS REPORT - DETAILED (",PRGBDT," to ",PRGEDT,")"
99 W ?117,"Page: ",PG,!,"Printed at ",SITE," on ",HDT
100 W !!,"RELATED EVENT PROTOCOL",!?3,"DATE",?18,"TYPE",?29,"STATUS IN FILE #772"
101 W ?61,"DATE PROCESSED",?83,"FILE #772 IEN"
102 W !?6,"=>FILE #773 ENTRY",?29,"STATUS IN FILE #773",?61,"DATE PROCESSED"
103 W ?83,"PROTOCOL",?116,"LOGICAL LINK",!,LN
104 Q
105 ;
106REPROC ;reprocess entries in xtmp global ^XTMP("REPROC"
107 S CNT=0
108 S HLMALINK=""
109 F S HLMALINK=$O(^XTMP("REPROC",HLMALINK)) Q:HLMALINK="" D
110 .S HLMAIEN=0
111 .F S HLMAIEN=$O(^XTMP("REPROC",HLMALINK,HLMAIEN)) Q:'HLMAIEN D
112 ..S CNT=CNT+1
113 W !!,CNT," messages to attempt to process."
114 ;
115 S CNT=0
116 S HLMALINK=""
117 F S HLMALINK=$O(^XTMP("REPROC",HLMALINK)) Q:HLMALINK="" D
118 .S HLMAIEN=0
119 .F S HLMAIEN=$O(^XTMP("REPROC",HLMALINK,HLMAIEN)) Q:'HLMAIEN D
120 ..S RGRTN=$G(^ORD(101,PROT,771))
121 ..I '$$REPROC^HLUTIL(HLMAIEN,RGRTN) S CNT=CNT+1
122 W !!,CNT," messages successfully processed."
123 K CNT,HLMALINK,HLMAIEN,RGRTN
124 Q
Note: See TracBrowser for help on using the repository browser.