135 lines
3.7 KiB
Mathematica
135 lines
3.7 KiB
Mathematica
SCMCHLR ;BP/DJB - PCMM HL7 Re-transmit Rejects ; 8/25/99 2:29pm
|
|
;;5.3;Scheduling;**177**;May 01, 1999
|
|
;
|
|
EN ;
|
|
NEW DFN,SCDELETE,SCMSG,VARPTR
|
|
TOP ;
|
|
D GETMSG ;............Get SCMSG() array for Austin Mailman message.
|
|
G:'SCMSG("IEN") EXIT ;Quit if no message selected.
|
|
D ARRAY ;.............Build array of message text
|
|
D PARSE G:'DFN EXIT ;.Get DFN, VARPTR, and SCDELETE
|
|
G:'$$ASK() TOP ;......Are they sure they want to re-transmit?
|
|
D RETRAN ;............Re-transmit selected items.
|
|
EXIT ;
|
|
KILL ^TMP("REJECTS",$J)
|
|
Q
|
|
;
|
|
GETMSG ;Prompt for reject message number.
|
|
;Output:
|
|
; SCMSG("IEN") - Message IEN
|
|
; Return SCMSG("IEN")=0 if no msg selected.
|
|
; SCMSG("SUBJ") - Message subject
|
|
; SCMSG("FROM") - Message sender
|
|
;
|
|
NEW %,%DT,ANS,DATA,HD,LINE,X,Y
|
|
;
|
|
S $P(LINE,"-",IOM)=""
|
|
S HD="RE-TRANSMIT PCMM HL7 MESSAGES"
|
|
W @IOF,!?(IOM-$L(HD)\2),HD
|
|
W !,LINE
|
|
W !!,"Select an Austin HL7 rejection Mailman message."
|
|
GETMSG1 KILL SCMSG
|
|
S SCMSG("IEN")=0
|
|
W !!,"Enter MESSAGE NUMBER: "
|
|
R ANS:300 S:'$T ANS="^" I "^"[ANS Q
|
|
I ANS=" " D G:'ANS GETMSG1
|
|
. S ANS=$G(^DISV(DUZ,"PCMM REJECTS"))
|
|
. W ANS
|
|
S DATA=$$NET^XMRENT(ANS)
|
|
I DATA="" D G GETMSG1
|
|
. W !,"Enter a valid Mailman message number or <RET> to Quit."
|
|
;
|
|
;Check if this is a valid reject message.
|
|
S SCMSG("FROM")=$P(DATA,"^",3)
|
|
I SCMSG("FROM")'="Austin" D GETMSG2 G GETMSG1
|
|
S SCMSG("SUBJ")=$P(DATA,"^",6)
|
|
I SCMSG("SUBJ")'?.E D GETMSG2 G GETMSG1
|
|
S SCMSG("IEN")=ANS
|
|
;
|
|
;Support for <SPACE BAR><RET> convention
|
|
S ^DISV(DUZ,"PCMM REJECTS")=ANS
|
|
Q
|
|
GETMSG2 ;
|
|
W !,"Sorry, not a valid PCMM HL7 reject message number."
|
|
Q
|
|
;
|
|
ARRAY ;Build array of message text.
|
|
NEW CNT,X,XMER,XMPOS,XMRG,XMZ
|
|
;
|
|
KILL ^TMP("REJECTS",$J)
|
|
S CNT=1
|
|
S XMZ=SCMSG("IEN")
|
|
F S X=$$READ^XMGAPI1() Q:XMER=-1 D ;
|
|
. S ^TMP("REJECTS",$J,CNT)=X
|
|
. S CNT=CNT+1
|
|
Q
|
|
;
|
|
PARSE ;Parse out DFN and VARPTR from text of message
|
|
;Return: DFN - Patient IEN
|
|
; VARPTR - Variable pointer
|
|
;
|
|
NEW ID,IDLONG,LN,PTPI
|
|
;
|
|
S LN=$G(^TMP("REJECTS",$J,1))
|
|
S DFN=+LN ;................................Patient IEN
|
|
I 'DFN D Q
|
|
. W !,"Cannot identify patient. Aborting."
|
|
S LN=$G(^TMP("REJECTS",$J,2))
|
|
S ID=$P(LN," ",1) ;........................Get ID
|
|
S ID=$P(ID,"-",2) ;........................Strip off facility number
|
|
I 'ID D Q
|
|
. S DFN=0
|
|
. W !,"Cannot identify event ID. Aborting."
|
|
S IDLONG=$P($G(^SCPT(404.49,ID,0)),U,1) ;..Get long form of ID
|
|
S PTPI=$P(IDLONG,"-",1) ;..................File 404.43 IEN
|
|
I 'PTPI D Q
|
|
. S DFN=0
|
|
. W !,"Cannot identify long ID. Aborting."
|
|
I '$D(^SCPT(404.43,PTPI)) S SCDELETE=1 ;...Flag to process a delete
|
|
S VARPTR=PTPI_";SCPT(404.43," ;............Create event pointer
|
|
Q
|
|
;
|
|
ASK() ;Ask if they want to re-tranmit selected msgs.
|
|
NEW %,%Y
|
|
W !!,"Patient: ",$P($G(^DPT(DFN,0)),U,1)
|
|
ASK1 W !!,"Are you sure you want to re-transmit"
|
|
S %=1 D YN^DICN
|
|
I %=0 W " Enter YES or NO" G ASK1
|
|
I %'=1 Q 0
|
|
Q 1
|
|
;
|
|
RETRAN ;Re-transmit selected items.
|
|
;
|
|
NEW PT,PTPI,RESULT,SCFAC,XMITARRY
|
|
NEW HL,HLECH,HLEID,HLFS,HLQ
|
|
;
|
|
;Initialize array
|
|
S XMITARRY="^TMP(""PCMM"",""HL7"","_$J_")" ;..Segments
|
|
KILL @XMITARRY
|
|
;
|
|
;Get faciltiy number
|
|
S SCFAC=+$P($$SITE^VASITE(),"^",3)
|
|
;
|
|
;Get pointer to sending event
|
|
S HLEID=$$HLEID^SCMCHL()
|
|
I 'HLEID D Q
|
|
. W "Unable to initialize HL7 variables - protocol not found"
|
|
;
|
|
;Initialize HL7 variables
|
|
D INIT^HLFNC2(HLEID,.HL)
|
|
I $O(HL(""))="" W $P(HL,"^",2) Q
|
|
;
|
|
;Build segment array
|
|
I $G(SCDELETE) D I 1 ;....................Process a deletion
|
|
. S PTPI=$P(VARPTR,";",1)
|
|
. D PTPD^SCMCHLB2(PTPI)
|
|
E D I +RESULT<0 W $P(RESULT,"^",2) Q ;..Process a normal entry
|
|
. S RESULT=$$BUILD^SCMCHLB(VARPTR,.HL,.XMITARRY)
|
|
;
|
|
;Generate message
|
|
;S RESULT=$$GENERATE^SCMCHLG()
|
|
;
|
|
KILL @XMITARRY
|
|
W !!,"Message re-transmitted...",!
|
|
Q
|