Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCHLR

SCMCHLR.m

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