source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSRPT1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1HLCSRPT1 ;ISC-SF/RAH-TRANS LOG PENDING MSG LIST;05/12/03 11:43 AM
2 ;;1.6;HEALTH LEVEL SEVEN;**19,50,107**;Oct 13, 1995
3 ;
4 Q
5 ;
6EN ; Entry Point for Pending Message Search.
7 D LNKSRCH Q:$D(STOP)
8 I HLCSLS=1 D SEARCH1 Q
9 D SEARCH2
10 Q
11 ;
12 ;
13SEARCH1 ;
14 W !!," . . . PLEASE WAIT, THIS CAN TAKE AWHILE . . .",!
15 S HLCSI=0,HLCSIO="" S HLCSLN=0
16 F S HLCSIO=$O(^HLMA("AC",HLCSIO)) Q:(HLCSIO="") D
17 . S HLCSN=HLCSI,HLCSJ=0
18 . F S HLCSJ=$O(^HLMA("AC",HLCSIO,HLCSLINK,HLCSJ)) Q:(HLCSJ="") D
19 .. I '$D(^HLMA(HLCSJ,0)) Q
20 .. I '$D(^HLMA("AG",1,HLCSJ)) Q
21 .. S HLCSX=^HLMA(HLCSJ,0),HLCSDTE=$P(HLCSX,U,1)
22 .. S HLCSLNK=" "
23 .. I $D(^HLCS(870,HLCSLINK,0)) S HLCSLNK=$P(^HLCS(870,HLCSLINK,0),U,1)
24 .. S HLCSEVN1=$P(HLCSX,U,13) I HLCSEVN1'="",($D(^HL(771.2,HLCSEVN1,0))) S HLCSEVN1=$P(^HL(771.2,HLCSEVN1,0),U,1)
25 .. S HLCSEVN2=$P(HLCSX,U,14) I HLCSEVN2'="",($D(^HL(779.001,HLCSEVN2,0))) S HLCSEVN2=$P(^HL(779.001,HLCSEVN2,0),U,1)
26 .. I HLCSEVN1="" S HLCSEVN1=" "
27 .. I HLCSEVN2="" S HLCSEVN2=" "
28 .. I $L(HLCSEVN1)<3 S HLCSEVN1=HLCSEVN1_" ",HLCSEVN1=$E(HLCSEVN1,1,3)
29 .. I $L(HLCSEVN2)<3 S HLCSEVN2=HLCSEVN2_" ",HLCSEVN2=$E(HLCSEVN2,1,3)
30 .. S HLCSEVN=HLCSEVN1_":"_HLCSEVN2
31 .. D FORMAT^HLCSRPT
32 .. Q
33 . Q
34 I '$D(^TMP("TLOG",$J,1)) W !!,HLCSNREC,!! S DIR(0)="E" D ^DIR K DIR Q
35 I VERS22'="YES" S HLCSTITL="IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR"
36 E S HLCSTITL="MESSAGE ID # D/T Entered Log Link Msg:Evn IO Sndg Apl Rcvr Apl "
37 I VERS22'="YES" D FAKR
38 D DISPLAY^HLCSRPT K ^TMP("TLOG",$J)
39 Q
40 ;
41SEARCH2 ;
42 W !!," . . . PLEASE WAIT, THIS CAN TAKE AWHILE . . .",!
43 S HLCSI=0,HLCSIO="" S HLCSLN=0
44 F S HLCSIO=$O(^HLMA("AC",HLCSIO)) Q:(HLCSIO="") D
45 . S HLCSN=HLCSI,HLCSJ=0,HLCSLINK=0
46 . F S HLCSLINK=$O(^HLMA("AC",HLCSIO,HLCSLINK)) Q:(HLCSLINK="") D
47 .. F S HLCSJ=$O(^HLMA("AC",HLCSIO,HLCSLINK,HLCSJ)) Q:(HLCSJ="") D
48 ... I '$D(^HLMA(HLCSJ,0)) Q
49 ... I '$D(^HLMA("AG",1,HLCSJ)) Q
50 ... S HLCSX=^HLMA(HLCSJ,0),HLCSDTE=$P(HLCSX,U,1)
51 ... S HLCSLNK=" "
52 ... I $D(^HLCS(870,HLCSLINK,0)) S HLCSLNK=$P(^HLCS(870,HLCSLINK,0),U,1)
53 ... S HLCSEVN1=$P(HLCSX,U,13) I HLCSEVN1'="",($D(^HL(771.2,HLCSEVN1,0))) S HLCSEVN1=$P(^HL(771.2,HLCSEVN1,0),U,1)
54 ... S HLCSEVN2=$P(HLCSX,U,14) I HLCSEVN2'="",($D(^HL(779.001,HLCSEVN2,0))) S HLCSEVN2=$P(^HL(779.001,HLCSEVN2,0),U,1)
55 ... I HLCSEVN1="" S HLCSEVN1=" "
56 ... I HLCSEVN2="" S HLCSEVN2=" "
57 ... I $L(HLCSEVN1)<3 S HLCSEVN1=HLCSEVN1_" ",HLCSEVN1=$E(HLCSEVN1,1,3)
58 ... I $L(HLCSEVN2)<3 S HLCSEVN2=HLCSEVN2_" ",HLCSEVN2=$E(HLCSEVN2,1,3)
59 ... S HLCSEVN=HLCSEVN1_":"_HLCSEVN2
60 ... D FORMAT^HLCSRPT
61 ... Q
62 .. Q
63 . Q
64 I '$D(^TMP("TLOG",$J,1)) W !!,HLCSNREC,!! S DIR(0)="E" D ^DIR K DIR Q
65 I VERS22'="YES" S HLCSTITL="IEN RECORD # MESSAGE ID # Log Link Msg:Evn IO Sndg Apl Rcvr Apl HDR"
66 E S HLCSTITL="MESSAGE ID # D/T Entered Log Link Msg:Evn IO Sndg Apl Rcvr Apl "
67 I VERS22'="YES" D FAKR
68 D DISPLAY^HLCSRPT K ^TMP("TLOG",$J)
69 Q
70 ;
71LNKSRCH ; Report pending messages on A logical link.
72 W @IOF,! S HLCSHDR="Logical Link Selection" D HLCSBAR
73 S DIR(0)="PAO^870:AEO",DIR("A")="Select Logical Link: ALL//"
74 D ^DIR S:($D(DTOUT)!($D(DUOUT))) STOP=1 Q:$D(STOP)
75 I X="" S HLCSLS="" K DIR,X,Y Q
76 I Y=-1 W !,X_" NOT VALID " K X,Y G LNKSRCH
77 S HLCSLINK=$P(Y,U,1),HLCSLNK=$P(Y,U,2) K DIR,X,Y
78 S HLCSLS=1
79 Q
80 ;
81FAKR ; Build fake record to pass FM21 Browser edits.
82 S HLCSJ=^TMP("TLOG",$J,1)
83 S HLCSJ=+$P(HLCSJ," ",1)
84 S ^TMP($J,"MESSAGE",HLCSJ,0)="^^1^1"
85 S ^TMP($J,"MESSAGE",HLCSJ,1,0)=" Fake Record to pass Browser edits. "
86 S HLCSRNO=HLCSJ
87 Q
88 ;
89SHOWMSG(XXY,XXZ) ;
90 ; Each node, ^tmp($j,"message",record_ien), invokes this code
91 ; to compile a 'virtual w-p document' when a message is browsed.
92 I $D(^HLMA(XXY,"MSH",0)) D
93 . S ^TMP($J,"MESSAGE",XXY,0)=^HLMA(XXY,"MSH",0)
94 . S YY1=$P(^HLMA(XXY,"MSH",0),U,3),YY2=$P(^HLMA(XXY,"MSH",0),U,4)
95 E S ^TMP($J,"MESSAGE",XXY,0)="1^1"
96 S XLINE=^HLMA(XXY,0)
97 S LINE="Record #: "_XXY_" ",LINE=$E(LINE,1,30)
98 S LINE=LINE_"Message #: "_$P(XLINE,U,2)
99 S ^TMP($J,"MESSAGE",XXY,1,0)=LINE
100 S DTE=$P(XLINE,U,1) I $P($G(^HL(772,DTE,0)),U,1)'="" S DTE=$P(^HL(772,DTE,0),U,1),DTE=$E(DTE,4,7)_$E(DTE,2,3)_"."_$P(DTE,".",2)_" "
101 I $D(^HLMA(XXY,"S")),$P(^HLMA(XXY,"S"),U,1)'="" S DTP=$P(^HLMA(XXY,"S"),U,1) S DTP=$E(DTP,4,7)_$E(DTP,2,3)_"."_$P(DTP,".",2)
102 E S DTP=" "
103 S LINE="D/T Entered: "_DTE,LINE=$E(LINE,1,30)_"D/T Processed: "_DTP
104 S ^TMP($J,"MESSAGE",XXY,2,0)=LINE K DTE,DTP
105 S LINE="Logical Link: " I $P(XLINE,U,7)'="",($D(^HLCS(870,$P(XLINE,U,7),0))) S LINE=LINE_$P(^HLCS(870,$P(XLINE,U,7),0),U,1)
106 S LINE=LINE_" ",LINE=$E(LINE,1,30)
107 S LINE=LINE_"Ack To MSG#: " I $P(XLINE,U,6)'="",($D(^HLMA($P(XLINE,U,6),0))) S LINE=LINE_$P(^HLMA($P(XLINE,U,6),0),U,2)
108 S ^TMP($J,"MESSAGE",XXY,3,0)=LINE
109 S DTS="" I $P($G(^HLMA(XXY,"P")),U,2)'="" S DTS=$P(^HLMA(XXY,"P"),U,2),DTS=$E(DTS,4,7)_$E(DTS,2,3)_"."_$P(DTS,".",2)
110 S LINE="D/T STATUS: "_DTS_" ",LINE=$E(LINE,1,30),LINE=LINE_"STATUS: "
111 I $P(^HLMA(XXY,"P"),U,1)'="" S LINE=LINE_$P(^HL(771.6,+$P(^HLMA(XXY,"P"),U,1),0),U,1)
112 S ^TMP($J,"MESSAGE",XXY,4,0)=LINE K DTS
113 S LINE="ERR MSG: " I $P(^HLMA(XXY,"P"),U,3)'="" S LINE=LINE_$E($P(^HLMA(XXY,"P"),U,3),1,20)
114 S LINE=LINE_" ",LINE=$E(LINE,1,30)_"ERR TYPE: "
115 I $P(^HLMA(XXY,"P"),U,4)'="" S LINE=LINE_$P(^HL(771.7,+$P(^HLMA(XXY,"P"),U,4),0),U,1)
116 S ^TMP($J,"MESSAGE",XXY,5,0)=LINE
117 S LINE="Sending Appl: " I $P(XLINE,U,11)'="",($D(^HL(771,$P(XLINE,U,11),0))) S LINE=LINE_$P(^HL(771,$P(XLINE,U,11),0),U,1)
118 S ^TMP($J,"MESSAGE",XXY,6,0)=LINE
119 S LINE="Receiving Appl: " I $P(XLINE,U,12)'="",($D(^HL(771,$P(XLINE,U,12),0))) S LINE=LINE_$P(^HL(771,$P(XLINE,U,12),0),U,1)
120 S ^TMP($J,"MESSAGE",XXY,7,0)=LINE
121 S LINE="Message Type: " I $P(XLINE,U,13)'="",($D(^HL(771.2,$P(XLINE,U,13),0))) S LINE=LINE_$P(^HL(771.2,$P(XLINE,U,13),0),U,1)
122 S LINE=LINE_" ",LINE=$E(LINE,1,30)_"Event Type: "
123 I $P(XLINE,U,14)'="",($D(^HL(779.001,$P(XLINE,U,14),0))) S LINE=LINE_$P(^HL(779.001,$P(XLINE,U,14),0),U,1)
124 S ^TMP($J,"MESSAGE",XXY,8,0)=LINE K LINE,XLINE
125 S ^TMP($J,"MESSAGE",XXY,9,0)="MESSAGE HEADER: "
126 S LN1=.5,LN2=10
127 I $D(^HLMA(XXY,"MSH",0)) D
128 . F S LN1=$O(^HLMA(XXY,"MSH",LN1)) Q:LN1="" D
129 .. S ^TMP($J,"MESSAGE",XXY,LN2,0)=^HLMA(XXY,"MSH",LN1,0)
130 .. ;HL*1.6*107 start: to fix the multiple lines per segment
131 .. ;S LN2=LN2+1,LN1=LN1+1
132 .. S LN2=LN2+1
133 .. ;HL*1.6*107 end
134 ..Q
135 S LN1=.5
136 S ^TMP($J,"MESSAGE",XXY,LN2,0)="MESSAGE TEXT: ",LN2=LN2+1
137 I $D(^HL(772,XXZ,"IN",0)) D
138 . F S LN1=$O(^HL(772,XXZ,"IN",LN1)) Q:(LN1="") D
139 .. S ^TMP($J,"MESSAGE",XXY,LN2,0)=^HL(772,XXZ,"IN",LN1,0)
140 .. ;HL*1.6*107 start: to fix the multiple lines per segment
141 .. ;S LN2=LN2+1,LN1=LN1+1
142 .. S LN2=LN2+1
143 .. ;HL*1.6*107 end
144 ..Q
145 S (YY1,YY2)=LN2-1
146 S Y1Y2=YY1_"^"_YY2
147 S $P(^TMP($J,"MESSAGE",XXY,0),U,3,4)=Y1Y2
148 K LN1,LN2,Y1Y2,YY1,YY2
149 Q
150 ;
151HLCSBAR ; Center Title on Top Line of Screen
152 W RVON,?(80-$L(HLCSHDR)\2),HLCSHDR,$E(SPACE,$X,77),RVOFF,!
153 Q
154 ;
Note: See TracBrowser for help on using the repository browser.