source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR6.m@ 1410

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1HLCSHDR6 ;OIRMFO/LJA - Make HL7 header for TCP ;1/27/03 15:30
2 ;;1.6;HEALTH LEVEL SEVEN;**93**;Oct 13, 1995
3 ;
4MARKERRA ; Mark 772 & 773 entries in error (to stop messaging)...
5 N %ZHO,ERR,ERREA,HLD,HLTCP,IEN772,IEN773,MSH,N02,POSX,X
6 D HDERR
7 R !!,"Enter ERROR REASON: ",ERREA:999 Q:'$T!(ERREA']"")!(ERREA[U) ;->
8 F D Q:'IEN772 W !!,$$REPEAT^XLFSTR("-",IOM)
9 . R !!," 772: ",IEN772:9999 Q:IEN772'>0!('$T) ;->
10 . S N02=$G(^HL(772,+IEN772,0))
11 . W !!,"772-0: "
12 . S POSX=$X
13 . W $E(N02,1,IOM-POSX)
14 . S X=$G(^HL(772,+IEN772,"P")) I X]"" W !,?(POSX-3),"P: ",$E(X,1,IOM-POSX)
15 . KILL HLD
16 . W:$D(^HLMA("B",+IEN772)) !!,"773s:",?POSX
17 . S IEN773=0
18 . F S IEN773=$O(^HLMA("B",+IEN772,IEN773)) Q:IEN773'>0 D
19 . . W:$X>POSX ! W:$X<POSX ?POSX
20 . . S HLD(IEN773)=""
21 . . S X=$G(^HLMA(+IEN773,"P")) I X]"" W " P: ",$E(X,1,IOM-$X)
22 . . W:$X>POSX ! W:$X<POSX ?POSX
23 . . W "MSH: "
24 . . S POSX=$X
25 . . S MSH=$G(^HLMA(+IEN773,"MSH",1,0))
26 . . F D Q:MSH']""
27 . . . W:$X>POSX ! W:$X<POSX ?POSX
28 . . . W $E(MSH,1,IOM-POSX)
29 . . . S MSH=$E(MSH,IOM-POSX+1,999)
30 . R !!,"Press RETURN to mark errored, or enter '^' to abort... ",X:999 I '$T!(X]"") D QUIT ;->
31 . . W " no action taken..."
32 . W !!,?10,"Marking 772's #",IEN772," errored... "
33 . S ERR=$$ERR(772,IEN772,ERREA)
34 . W $S(ERR:" done...",1:"Aborted!! "_$P(ERR,U,2)_"...")
35 . I '$D(HLD) QUIT ;->
36 . S IEN773=0
37 . F S IEN773=$O(HLD(IEN773)) Q:IEN773'>0 D
38 . . W !,?10,"Marking 773's #",IEN773," errored... "
39 . . S ERR=$$ERR(773,IEN773,ERREA)
40 . . W $S(ERR:" done...",1:"Aborted!! "_$P(ERR,U,2)_"...")
41 ;
42 Q
43 ;
44MARKERRG ; Global-based error marking of 772, 773...
45 N %ZHO,ERR,ERREA,HLD,HLTCP,IEN772,IEN773,MSH,N02,POSX,X
46 D HDERR
47 R !!,"Enter ERROR REASON: ",ERREA:999 Q:'$T!(ERREA']"")!(ERREA[U) ;->
48 I '$D(^TMP("HLCSHDR5 ERR",$J)) D QUIT ;->
49 . W !!,"No ^TMP(""HLCSHDR5 ERR"",$J) data exists..."
50 . W !
51 W !!,"The entries in ^TMP(""HLCSHDR5 ERR"",$J) will be marked in error now."
52 R !!,"Press RETURN to start error marking... ",X:999 Q:'$T!(X]"") ;->
53 ;
54ERRQ S IEN772=0
55 F S IEN772=$O(^TMP("HLCSHDR5 ERR",$J,IEN772)) Q:IEN772'>0 D
56 . W !,"Marking 772's #",IEN772,"... "
57 . S ERR=$$ERR(772,IEN772,ERREA)
58 . W $S(ERR:" done...",1:"Aborted!! "_$P(ERR,U,2)_"...")
59 . S IEN773=0
60 . F S IEN773=$O(^HLMA("B",IEN772,IEN773)) Q:IEN773'>0 D
61 . . S ERR=$$ERR(773,IEN773,ERREA)
62 . . W !," - 773# ",IEN773," checked..."
63 Q
64 ;
65HDERR W @IOF,$$CJ^XLFSTR("Error Marking Utility",IOM)
66 W !,$$REPEAT^XLFSTR("=",IOM)
67 Q
68 ;
69ERR(FILE,IEN,ERREA) ; Change status to ERROR for 772 or 773 (if the P
70 ; node status exists.)
71 ;
72 N DATA,ERR,HLTCP
73 ;
74 I FILE=772 D QUIT:ERR U_$P(ERR,U,2,99) ;->
75 . S ERR=""
76 . I $G(^HL(772,+$G(IEN),0))']"" S ERR="1^NO 772 0 NODE" QUIT ;->
77 ;
78 I FILE=773 D QUIT:ERR U_$P(ERR,U,2,99) ;->
79 . S HLTCP=1 ; Used by STATUS^HLTF0
80 . S ERR=""
81 . I $G(^HLMA(+$G(IEN),0))']"" S ERR="1^NO 773 0 NODE" ;->
82 ;
83 QUIT:$G(ERREA)']"" "^NO REASON" ;->
84 ;
85 ; Does entry need to be marked in error. (Only mark if status
86 ; already exists)
87 S DATA=$S(FILE=772:$G(^HL(772,+IEN,"P")),1:$G(^HLMA(+IEN,"P")))
88 QUIT:$P(DATA,U)']"" 1 ;->
89 ;
90 D STATUS^HLTF0(IEN,4,"",ERREA,1)
91 ;
92 Q 1
93 ;
94EOR ;HLCSHDR6 - Make HL7 header for TCP ;1/27/03 15:30
Note: See TracBrowser for help on using the repository browser.