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

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1RGMTHLDB ;BIR/CML-MPI/PD HL7 ACTIVITY BY PATIENT/SINGLE PROTOCOL ;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(772 supported by IA #3464
6 ;Reference to ^DPT(DFN,"MPI" supported by IA #2070
7 ;
8 S QFLG=1
9CHK ;
10 I '$D(^XTMP("RGMT","HL")) D G QUIT
11 .W !!,$C(7),"The option ""Compile MPI/PD HL7 Data"" must have"
12 .W !,"run to completion before this report can be printed!"
13 ;
14 I '$D(^XTMP("RGMT","HL","@@@@","STOPPED")) D G QUIT
15 .W !!,$C(7),"The option ""Compile MPI/PD HL7 Data"" is currently running."
16 .W !,"This report cannot be generated until the compile has run to completion."
17 .W !!,"Please try again later.",!
18 ;
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 activity related to a specific protocol in"
26 W !,"the HL7 MESSAGE TEXT (#772) file for a patient during a selected period of time."
27 W !,"This 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 Protocol
31 W !
32 S DIC="^ORD(101,",DIC(0)="QEAM"
33 S DIC("S")="S ORD=$P(^(0),""^"") I $D(^XTMP(""RGMT"",""HL"",ORD))"
34 D ^DIC K DIC G:Y<0 QUIT S PROT=$P(Y,"^",2)
35 ;
36ASK2 ;Ask for Date Range
37 W !
38 K DIR,DIRUT,DTOUT,DUOUT
39 S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date: "
40 D ^DIR K DIR G:$D(DIRUT) QUIT
41 ;
42 S RGBDT=Y,DIR(0)="DAO^"_RGBDT_":DT:EPX",DIR("A")="Ending Date: "
43 D ^DIR K DIR G:$D(DIRUT) QUIT S RGEDT=Y
44 ;
45ASK3 ;Ask for TYPE
46 W !
47 S DIR(0)="SB^I:INCOMING;O:OUTGOING",DIR("A")="Select TYPE"
48 D ^DIR K DIR G:$D(DIRUT) QUIT S TYPE=Y
49 ;
50ASK4 ;Ask for PATIENT
51 W !!!,"Patient lookup can be done by (P)atient Name/SSN or by (I)CN.",!
52 S DIR(0)="SB^I:ICN;P:PATIENT NAME/SSN",DIR("A")="Select LOOKUP",DIR("B")="P"
53 D ^DIR K DIR G:$D(DIRUT) QUIT S LOOKUP=Y
54 I LOOKUP="P" D LOOKUP1 G:'$D(DFN) ASK4
55 I LOOKUP="I" D LOOKUP2 G:'$D(DFN) ASK4
56 ;
57DEV ;
58 W !!,"The right margin for this print is 80.",!!
59 S ZTSAVE("RGBDT")="",ZTSAVE("RGEDT")="",ZTSAVE("PROT")=""
60 S ZTSAVE("TYPE")="",ZTSAVE("DFN")="",ZTSAVE("ICN")=""
61 D EN^XUTMDEVQ("START^RGMTHLDB","MPI/PD - Print HL7 Message Data for Patient/Single Protocol") I 'POP Q
62 W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
63 G QUIT
64START ;
65 G:'$D(^XTMP("RGMT","HL")) QUIT
66 S (PG,QFLG,GOTDATA)=0,U="^",$P(LN,"-",81)="",SITE=$P($$SITE^VASITE(),U,2)
67 S PRGBDT=$$FMTE^XLFDT(RGBDT),PRGEDT=$$FMTE^XLFDT(RGEDT)
68 D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
69 D HDR
70 ;
71LOOP ;Loop on ^XTMP("RGMT","HLICN" & ^XTMP("RGMT","HLDFN"
72 I '$D(^XTMP("RGMT","HLICN"))&'($D(^XTMP("RGMT","HLDFN"))) G QUIT
73 S STOPDT=RGEDT_".9"
74 F SUB1="HLICN","HLDFN" S SUB2=$S(SUB1="HLICN":ICN,1:DFN) Q:QFLG D
75 .S RGDT=RGBDT-.1
76 .F S RGDT=$O(^XTMP("RGMT",SUB1,SUB2,RGDT)) Q:'RGDT Q:RGDT>STOPDT Q:QFLG D
77 ..S STAT="" F S STAT=$O(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT)) Q:STAT="" Q:QFLG D
78 ...S IEN=0 F S IEN=$O(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN)) Q:'IEN Q:QFLG D
79 ....I ^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN)]"" D BATCHPRT Q
80 ....I $O(^HL(772,IEN,"IN",0)) S GOT=0 D Q:QFLG
81 .....S TXT=0 F S TXT=$O(^HL(772,IEN,"IN",TXT)) Q:'TXT Q:QFLG D Q:GOT Q:QFLG
82 ......I $P(^HL(772,IEN,"IN",TXT,0),U)="PID",+$P(^(0),U,3)=ICN D PROC Q
83 ......I $P(^HL(772,IEN,"IN",TXT,0),U)="MFE",$P(^(0),U,2)="MAD",+$P($P(^(0),U,5),"~",4)=ICN D PROC Q
84 ......I $P(^HL(772,IEN,"IN",TXT,0),U)="MFE",$P(^(0),U,2)="MUP",+$P(^(0),U,5)=ICN D PROC Q
85 ......I $P(^HL(772,IEN,"IN",TXT,0),U)="QAK",+$P(^(0),U,2)=DFN D PROC
86 I 'GOTDATA W !,"No data found for this patient."
87 ;
88QUIT ;
89 I $E(IOST)="C"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
90 .S SS=22-$Y F JJ=1:1:SS W !
91 K %,BATCHIEN,CNT,DFN,GOT,GOTDATA,HDT,ICN,IEN,JJ,LIM,LINE,LN,LOOKUP,NODE,NUM,PG,PRGBDT
92 K PRGEDT,PROT,QFLG,RGBDT,RGDT,RGEDT,SITE,SS,STAT,STOPDT,SUB1,SUB2,TXT,TYPE,Y,ZTSK
93 W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
94 ;
95HDR ;HEADER
96 I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
97 I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
98 S PG=PG+1 W:$Y!($E(IOST)="C") @IOF I $E(IOST)'="C"!($E(IOST)="C"&(PG=1)) D
99 .W !,"HL7 TRANSMISSION DATA at ",SITE," on ",HDT,?72,"Page: ",PG
100 .W !!,"Patient: ",$P(^DPT(DFN,0),U)
101 .W !,"Protocol: ",PROT
102 .W !,"Date Range: ",PRGBDT," to ",PRGEDT,?45,"Type: ",$S(TYPE="I":"INCOMING",1:"OUTGOING"),!
103 W !,"File #772 IEN",?19,"Date",?39,"Status",!?4,"""IN"" Subfield",!,LN
104 Q
105 ;
106BATCHPRT ;
107 S GOTDATA=1
108 D:$Y+4>IOSL HDR Q:QFLG
109 S BATCHIEN=+$P(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN),",""IN"",",2)
110 W !,"Batch Msg #",IEN," - Line #",BATCHIEN
111 W !?19,$$FMTE^XLFDT($E(RGDT,1,12)),?39,STAT,!
112 S NODE=^HL(772,IEN,"IN",BATCHIEN,0)
113 I $L(NODE)>75 D BREAK Q
114 W !?4,NODE
115 Q
116 ;
117PROC ;Print data
118 S GOT=1,GOTDATA=1
119 W !,IEN,?19,$$FMTE^XLFDT($E(RGDT,1,12)),?39,STAT,!
120 S NUM=0 F S NUM=$O(^HL(772,IEN,"IN",NUM)) Q:'NUM Q:QFLG S NODE=^HL(772,IEN,"IN",NUM,0) D
121 .I $L(NODE)>75 D BREAK Q
122 .D:$Y+3>IOSL HDR Q:QFLG W !?4,NODE
123 Q
124 ;
125BREAK ;Break up text lines greater than 75
126 S CNT=1,LIM=$L(NODE)/75 I LIM["." S LIM=$P(LIM,".")+1
127 F LINE=1:1:LIM D:$Y+3>IOSL HDR Q:QFLG W !?4,$E(NODE,CNT,CNT+74) S CNT=CNT+75
128 Q
129 ;
130LOOKUP1 ;Lookup by patient name/ssn
131 W ! K DFN,ICN
132 S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: " D ^DIC K DIC
133 Q:Y<0
134 S DFN=+Y
135 S ICN=+$P($G(^DPT(DFN,"MPI")),U) I 'ICN W !!,"This patient does not have an ICN!" K DFN,ICN
136 Q
137 ;
138LOOKUP2 ;Lookup by ICN
139 W ! K DFN,ICN
140 S DIR(0)="N:1:999999999999:0",DIR("A")="Select ICN" D ^DIR K DIR Q:$D(DIRUT)
141 S ICN=Y S DFN=$$GETDFN^MPIF001(ICN)
142 I +DFN<0 W !!,"No patient match can be found for this ICN!" K DFN,ICN Q
143 W " ",$P(^DPT(DFN,0),"^")
144 Q
Note: See TracBrowser for help on using the repository browser.