source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTHLDP.m@ 1245

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1RGMTHLDP ;BIR/CML-MPI/PD HL7 ACTIVITY BY PATIENT/ALL PROTOCOLS ;11/05/01
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**21**;30 Apr 99
3 ;
4 ;Reference to ^ORD(101 supported by IA #2596
5 ;Reference to ^HL(771.6 supported by IA #2507
6 ;Reference to ^HLMA( supported by IA #3273
7 ;Reference to ^HLCS(870 supported by IA #2525
8 ;Reference to ^DPT(DFN,"MPI" supported by IA #2070
9 ;
10 S QFLG=1
11CHK ;
12 I '$D(^XTMP("RGMT","HL")) D G QUIT
13 .W !!,$C(7),"The option ""Compile MPI/PD HL7 Data"" must have"
14 .W !,"run to completion before this report can be printed!"
15 I '$D(^XTMP("RGMT","HL","@@@@","STOPPED")) D G QUIT
16 .W !!,$C(7),"The option ""Compile MPI/PD HL7 Data"" is currently running."
17 .W !,"This report cannot be generated until the compile has run to completion."
18 .W !!,"Please try again later.",!
19 W @IOF
20 I $D(^XTMP("RGMT","HL","@@@@","RANGE")) D
21 .W !!,"Data has been compiled for ",^XTMP("RGMT","HL","@@@@","RANGE"),"."
22 .W !,"Use the ""Compile MPI/PD HL7 Data"" option if this range is not sufficient."
23 ;
24BEGIN ;
25 W !!,"This option allows you to search for ALL activity in the HL7 MESSAGE TEXT"
26 W !,"(#772) file for a specific patient during a selected period of time. This"
27 W !,"search is accomplished using data set into a temporary global built by the"
28 W !,"option ""Compile MPI/PD HL7 Data""."
29 ;
30ASK1 ;Ask for PATIENT
31 W !!!,"Patient lookup can be done by (P)atient Name/SSN or by (I)CN.",!
32 S DIR(0)="SB^I:ICN;P:PATIENT NAME/SSN",DIR("A")="Select LOOKUP",DIR("B")="P"
33 D ^DIR K DIR G:$D(DIRUT) QUIT S TYPE=Y
34 I TYPE="P" D LOOKUP1 G:'$D(ICN) ASK1 G ASK2
35 I TYPE="I" D LOOKUP2 G:'$D(ICN) ASK1
36 ;check if selected patient had activity in compiled data
37 I 'ICN,'$D(^XTMP("RGMT","HLDFN",DFN)) D MSG G QUIT
38 I '$D(^XTMP("RGMT","HLICN",ICN)) D MSG G QUIT
39 ;
40ASK2 ;Ask for Date Range
41 W !!,"Enter date range for data to be included in report."
42 K DIR,DIRUT,DTOUT,DUOUT
43 S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date: "
44 D ^DIR K DIR G:$D(DIRUT) QUIT S RGBDT=Y
45 S DIR(0)="DAO^"_RGBDT_":DT:EPX",DIR("A")="Ending Date: "
46 D ^DIR K DIR G:$D(DIRUT) QUIT S RGEDT=Y
47 ;
48DEV ;
49 W !!,"The right margin for this report is 80.",!!
50 S ZTSAVE("RGBDT")="",ZTSAVE("RGEDT")="",ZTSAVE("DFN")="",ZTSAVE("ICN")=""
51 D EN^XUTMDEVQ("START^RGMTHLDP","MPI/PD - Print HL7 Message Data for Patient/All Protocols") I 'POP Q
52 W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
53 G QUIT
54 ;
55START ;
56 K ^TMP("RGMTHLDP",$J) S U="^"
57 ;
58LOOP ;Loop on ^XTMP("RGMT","HLICN" & ^XTMP("RGMT","HLDFN"
59 I '$D(^XTMP("RGMT","HLICN"))&'($D(^XTMP("RGMT","HLDFN"))) G QUIT
60 S STOPDT=RGEDT_".9"
61 F SUB1="HLICN","HLDFN" S SUB2=$S(SUB1="HLICN":ICN,1:DFN) D
62 .S RGDT=RGBDT-.1
63 .F S RGDT=$O(^XTMP("RGMT",SUB1,SUB2,RGDT)) Q:'RGDT Q:RGDT>STOPDT D
64 ..S PROT="" F S PROT=$O(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT)) Q:PROT="" D
65 ...S TYPE="" F S TYPE=$O(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE)) Q:TYPE="" D
66 ....S STAT="" F S STAT=$O(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT)) Q:STAT="" D
67 .....S IEN=0 F S IEN=$O(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN)) Q:'IEN D
68 ......S ^TMP("RGMTHLDP",$J,PROT,RGDT,TYPE,STAT,IEN)=^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN)
69 ;
70PRT ;Print report
71 S (PG,QFLG)=0,U="^",$P(LN,"-",81)="",SITE=$P($$SITE^VASITE(),U,2)
72 S PRGBDT=$$FMTE^XLFDT(RGBDT),PRGEDT=$$FMTE^XLFDT(RGEDT)
73 D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
74 D HDR
75 S PROT="" F S PROT=$O(^TMP("RGMTHLDP",$J,PROT)) Q:PROT="" Q:QFLG W !!,PROT,":" D
76 .S RGDT=0
77 .F S RGDT=$O(^TMP("RGMTHLDP",$J,PROT,RGDT)) Q:'RGDT Q:QFLG D
78 ..S TYPE=""
79 ..F S TYPE=$O(^TMP("RGMTHLDP",$J,PROT,RGDT,TYPE)) Q:TYPE="" Q:QFLG D
80 ...S STAT=""
81 ...F S STAT=$O(^TMP("RGMTHLDP",$J,PROT,RGDT,TYPE,STAT)) Q:STAT="" Q:QFLG D
82 ....S IEN=0
83 ....F S IEN=$O(^TMP("RGMTHLDP",$J,PROT,RGDT,TYPE,STAT,IEN)) Q:'IEN Q:QFLG D
84 .....D:$Y+3>IOSL HDR Q:QFLG
85 .....W !!?4,$$FMTE^XLFDT($E(RGDT,1,12))
86 .....W ?25,$S(TYPE="O":"OUTGOING",1:"INCOMING"),?41,STAT,?69,IEN
87 .....I ^TMP("RGMTHLDP",$J,PROT,RGDT,TYPE,STAT,IEN)]"" D Q
88 ......W !?35,^TMP("RGMTHLDP",$J,PROT,RGDT,TYPE,STAT,IEN)
89 .....S HLMAIEN=0
90 .....F S HLMAIEN=$O(^HLMA("B",IEN,HLMAIEN)) Q:'HLMAIEN Q:QFLG D
91 ......S HLMASTAT=$P(^HL(771.6,($P(^HLMA(HLMAIEN,"P"),"^")),0),"^")
92 ......S HLMAPROT=$P(^ORD(101,$P(^HLMA(HLMAIEN,0),"^",8),0),"^")
93 ......S HLMALINK=$P(^HLCS(870,$P(^HLMA(HLMAIEN,0),"^",7),0),"^")
94 ......D:$Y+3>IOSL HDR Q:QFLG
95 ......W !?4,"=>^HLMA(",HLMAIEN,?24,$E(HLMAPROT,1,25),?50,$E(HLMASTAT,1,22),?74,HLMALINK
96 I '$D(^TMP("RGMTHLDP",$J)) W !!,"No data found for this patient."
97QUIT ;
98 I $E(IOST)="C"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
99 .S SS=22-$Y F JJ=1:1:SS W !
100 K ^TMP("RGMTHLDP",$J)
101 K %,DFN,GOT,HDT,ICN,IEN,JJ,LL,LN,PG,PRGBDT,PRGEDT,PROT,QFLG,RGBDT
102 K HLMAIEN,HLMASTAT,HLMAPROT,HLMALINK
103 K RGDT,RGEDT,SITE,SS,STAT,STOPDT,SUB1,SUB2,TXT,TYPE,X,Y,ZTSK
104 W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
105 Q
106 ;
107HDR ;HEADER
108 I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
109 I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
110 S PG=PG+1 W:$Y!($E(IOST)="C") @IOF
111 W !,"HL7 TRANSMISSION PATIENT DATA at ",SITE," on ",HDT,?72,"Page: ",PG
112 W !!,"Patient: ",$P(^DPT(DFN,0),U)
113 W !,"Date Range: ",PRGBDT," to ",PRGEDT
114 W !!,"Related Event Protocol"
115 W !?4,"Date",?26,"Type",?42,"Status",?69,"^HL(772,IEN"
116 W !?4,"=>^HLMA(IEN",?24,"Protocol",?50,"Status",?74,"Link",!,LN
117 Q
118 ;
119LOOKUP1 ;Lookup by patient name/ssn
120 W ! K DFN,ICN
121 S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: " D ^DIC K DIC
122 Q:Y<0
123 S DFN=+Y
124 S ICN=+$P($G(^DPT(DFN,"MPI")),U)
125 Q
126 ;
127LOOKUP2 ;Lookup by ICN
128 W ! K DFN,ICN
129 S DIR(0)="N:1:999999999999:0",DIR("A")="Select ICN" D ^DIR K DIR Q:$D(DIRUT)
130 S ICN=Y S DFN=$$GETDFN^MPIF001(ICN)
131 I +DFN<0 W !!,"No patient DFN match can be found for this ICN!" K DFN,ICN Q
132 W " ",$P(^DPT(DFN,0),"^")
133 Q
134 ;
135MSG ;
136 W !!,"This patient has no HL7 messaging activity in the current compiled data set."
137 Q
Note: See TracBrowser for help on using the repository browser.