| [613] | 1 | SCMCHLR ;BP/DJB - PCMM HL7 Re-transmit Rejects ; 8/25/99 2:29pm
|
|---|
| 2 | ;;5.3;Scheduling;**177**;May 01, 1999
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;
|
|---|
| 5 | NEW DFN,SCDELETE,SCMSG,VARPTR
|
|---|
| 6 | TOP ;
|
|---|
| 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.
|
|---|
| 13 | EXIT ;
|
|---|
| 14 | KILL ^TMP("REJECTS",$J)
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | GETMSG ;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."
|
|---|
| 31 | GETMSG1 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
|
|---|
| 52 | GETMSG2 ;
|
|---|
| 53 | W !,"Sorry, not a valid PCMM HL7 reject message number."
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | ARRAY ;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 | ;
|
|---|
| 67 | PARSE ;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 | ;
|
|---|
| 92 | ASK() ;Ask if they want to re-tranmit selected msgs.
|
|---|
| 93 | NEW %,%Y
|
|---|
| 94 | W !!,"Patient: ",$P($G(^DPT(DFN,0)),U,1)
|
|---|
| 95 | ASK1 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 | ;
|
|---|
| 101 | RETRAN ;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
|
|---|
