source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCHLR.m@ 975

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1SCMCHLR ;BP/DJB - PCMM HL7 Re-transmit Rejects ; 8/25/99 2:29pm
2 ;;5.3;Scheduling;**177**;May 01, 1999
3 ;
4EN ;
5 NEW DFN,SCDELETE,SCMSG,VARPTR
6TOP ;
7 D GETMSG ;............Get SCMSG() array for Austin Mailman message.
8 G:'SCMSG("IEN") EXIT ;Quit if no message selected.
9 D ARRAY ;.............Build array of message text
10 D PARSE G:'DFN EXIT ;.Get DFN, VARPTR, and SCDELETE
11 G:'$$ASK() TOP ;......Are they sure they want to re-transmit?
12 D RETRAN ;............Re-transmit selected items.
13EXIT ;
14 KILL ^TMP("REJECTS",$J)
15 Q
16 ;
17GETMSG ;Prompt for reject message number.
18 ;Output:
19 ; SCMSG("IEN") - Message IEN
20 ; Return SCMSG("IEN")=0 if no msg selected.
21 ; SCMSG("SUBJ") - Message subject
22 ; SCMSG("FROM") - Message sender
23 ;
24 NEW %,%DT,ANS,DATA,HD,LINE,X,Y
25 ;
26 S $P(LINE,"-",IOM)=""
27 S HD="RE-TRANSMIT PCMM HL7 MESSAGES"
28 W @IOF,!?(IOM-$L(HD)\2),HD
29 W !,LINE
30 W !!,"Select an Austin HL7 rejection Mailman message."
31GETMSG1 KILL SCMSG
32 S SCMSG("IEN")=0
33 W !!,"Enter MESSAGE NUMBER: "
34 R ANS:300 S:'$T ANS="^" I "^"[ANS Q
35 I ANS=" " D G:'ANS GETMSG1
36 . S ANS=$G(^DISV(DUZ,"PCMM REJECTS"))
37 . W ANS
38 S DATA=$$NET^XMRENT(ANS)
39 I DATA="" D G GETMSG1
40 . W !,"Enter a valid Mailman message number or <RET> to Quit."
41 ;
42 ;Check if this is a valid reject message.
43 S SCMSG("FROM")=$P(DATA,"^",3)
44 I SCMSG("FROM")'="Austin" D GETMSG2 G GETMSG1
45 S SCMSG("SUBJ")=$P(DATA,"^",6)
46 I SCMSG("SUBJ")'?.E D GETMSG2 G GETMSG1
47 S SCMSG("IEN")=ANS
48 ;
49 ;Support for <SPACE BAR><RET> convention
50 S ^DISV(DUZ,"PCMM REJECTS")=ANS
51 Q
52GETMSG2 ;
53 W !,"Sorry, not a valid PCMM HL7 reject message number."
54 Q
55 ;
56ARRAY ;Build array of message text.
57 NEW CNT,X,XMER,XMPOS,XMRG,XMZ
58 ;
59 KILL ^TMP("REJECTS",$J)
60 S CNT=1
61 S XMZ=SCMSG("IEN")
62 F S X=$$READ^XMGAPI1() Q:XMER=-1 D ;
63 . S ^TMP("REJECTS",$J,CNT)=X
64 . S CNT=CNT+1
65 Q
66 ;
67PARSE ;Parse out DFN and VARPTR from text of message
68 ;Return: DFN - Patient IEN
69 ; VARPTR - Variable pointer
70 ;
71 NEW ID,IDLONG,LN,PTPI
72 ;
73 S LN=$G(^TMP("REJECTS",$J,1))
74 S DFN=+LN ;................................Patient IEN
75 I 'DFN D Q
76 . W !,"Cannot identify patient. Aborting."
77 S LN=$G(^TMP("REJECTS",$J,2))
78 S ID=$P(LN," ",1) ;........................Get ID
79 S ID=$P(ID,"-",2) ;........................Strip off facility number
80 I 'ID D Q
81 . S DFN=0
82 . W !,"Cannot identify event ID. Aborting."
83 S IDLONG=$P($G(^SCPT(404.49,ID,0)),U,1) ;..Get long form of ID
84 S PTPI=$P(IDLONG,"-",1) ;..................File 404.43 IEN
85 I 'PTPI D Q
86 . S DFN=0
87 . W !,"Cannot identify long ID. Aborting."
88 I '$D(^SCPT(404.43,PTPI)) S SCDELETE=1 ;...Flag to process a delete
89 S VARPTR=PTPI_";SCPT(404.43," ;............Create event pointer
90 Q
91 ;
92ASK() ;Ask if they want to re-tranmit selected msgs.
93 NEW %,%Y
94 W !!,"Patient: ",$P($G(^DPT(DFN,0)),U,1)
95ASK1 W !!,"Are you sure you want to re-transmit"
96 S %=1 D YN^DICN
97 I %=0 W " Enter YES or NO" G ASK1
98 I %'=1 Q 0
99 Q 1
100 ;
101RETRAN ;Re-transmit selected items.
102 ;
103 NEW PT,PTPI,RESULT,SCFAC,XMITARRY
104 NEW HL,HLECH,HLEID,HLFS,HLQ
105 ;
106 ;Initialize array
107 S XMITARRY="^TMP(""PCMM"",""HL7"","_$J_")" ;..Segments
108 KILL @XMITARRY
109 ;
110 ;Get faciltiy number
111 S SCFAC=+$P($$SITE^VASITE(),"^",3)
112 ;
113 ;Get pointer to sending event
114 S HLEID=$$HLEID^SCMCHL()
115 I 'HLEID D Q
116 . W "Unable to initialize HL7 variables - protocol not found"
117 ;
118 ;Initialize HL7 variables
119 D INIT^HLFNC2(HLEID,.HL)
120 I $O(HL(""))="" W $P(HL,"^",2) Q
121 ;
122 ;Build segment array
123 I $G(SCDELETE) D I 1 ;....................Process a deletion
124 . S PTPI=$P(VARPTR,";",1)
125 . D PTPD^SCMCHLB2(PTPI)
126 E D I +RESULT<0 W $P(RESULT,"^",2) Q ;..Process a normal entry
127 . S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
128 ;
129 ;Generate message
130 ;S RESULT=$$GENERATE^SCMCHLG()
131 ;
132 KILL @XMITARRY
133 W !!,"Message re-transmitted...",!
134 Q
Note: See TracBrowser for help on using the repository browser.