150 lines
5.4 KiB
Mathematica
150 lines
5.4 KiB
Mathematica
VAFHLRO2 ;BP/JRP - BUILD OUTPATIENT HL7 ROLE SEGMENT;11/18/1997 ; 7/3/01 4:09pm
|
|
;;5.3;Registration;**160,215,389**;Aug 13, 1993
|
|
;
|
|
; ** Do not call this routine directly **
|
|
; ** Use supported call OUTPAT^VAFHLROL **
|
|
;
|
|
OUTPAT ;Build role segment for transmission of outpatient data
|
|
;
|
|
;Input : As defined in OUTPAT^VAFHLROL
|
|
;Output : As defined in OUTPAT^VAFHLROL
|
|
;Notes : Existance & validity of input assumed
|
|
; : Refer to OUTPAT^VAFHLROL for details
|
|
;
|
|
;Declare variables
|
|
N PTR200,CODEONLY,INSTID,ACTION,ROLE,ALTROLE,PERSON,TMP,RDATE
|
|
N VAFHLROL,CMPSEP,REPSEP,ESCSEP,SUBSEP
|
|
;Break out individual seperators from encoding characters
|
|
S CMPSEP=$E(ENCODE,1)
|
|
S REPSEP=$E(ENCODE,2)
|
|
S ESCSEP=$E(ENCODE,3)
|
|
S SUBSEP=$E(ENCODE,4)
|
|
;Initialize output array
|
|
K @OUTARR S @OUTARR@(0)=""
|
|
;Get pointer to provider out of parameter array
|
|
S PTR200=+$G(@PARAM@("PTR200"))
|
|
S:('$D(^VA(200,PTR200,0))) PTR200=0
|
|
;Get internal/external flag
|
|
S CODEONLY=+$G(@PARAM@("CODEONLY"))
|
|
;Build segment into temporary location
|
|
S VAFHLROL(0)="ROL"
|
|
S1 ;Role Instance ID (seq #1)
|
|
S INSTID=$G(@PARAM@("INSTID"),NULL)
|
|
S TMP=$P(INSTID,CMPSEP,1)
|
|
D:((TMP=NULL)!(TMP="")) ERROR^VAFHLRO1(1,OUTARR,"could not be determined")
|
|
S VAFHLROL(1)=FLDSEP_INSTID
|
|
S2 ;Action Code (seq #2)
|
|
S ACTION=$G(@PARAM@("ACTION"),NULL)
|
|
S TMP=",AD,UP,DE,CO,LI,UN,UC,"
|
|
I (TMP'[(","_ACTION_",")) D
|
|
.I ((ACTION=NULL)!(ACTION="")) D ERROR^VAFHLRO1(2,OUTARR,"could not be determined") Q
|
|
.D ERROR^VAFHLRO1(2,OUTARR,"was not valid")
|
|
S VAFHLROL(2)=FLDSEP_ACTION
|
|
S3 ;Role (seq #3, comp #1 - 3)
|
|
I ($D(@PARAM@("ROLE"))) D G S3C4
|
|
.;Use input value
|
|
.S ROLE=$G(@PARAM@("ROLE"),NULL)
|
|
.I ((ROLE="")!(ROLE=NULL)) D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")
|
|
.S TMP=$P(ROLE,CMPSEP,1)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(3,1)=FLDSEP_TMP
|
|
.S TMP=$P(ROLE,CMPSEP,2)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(3,2)=CMPSEP_TMP
|
|
.S TMP=$P(ROLE,CMPSEP,3)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(3,3)=CMPSEP_TMP
|
|
;Calculate value
|
|
I ('PTR200) D G S3C4
|
|
.D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")
|
|
.S VAFHLROL(3)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
|
|
K ROLE S RDATE=$G(@PARAM@("RDATE"))
|
|
D ROLE^VAFHLRO3(PTR200,"ROLE",NULL,RDATE)
|
|
I ('$D(ROLE)) D G S3C4
|
|
.D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")
|
|
.S VAFHLROL(3)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
|
|
;Strip out external values
|
|
I (CODEONLY) F TMP=1:1:3 S ROLE(2,TMP)=NULL
|
|
;Copy and add appropriate seperators
|
|
; (Convert any HL7 characters into spaces)
|
|
S TMP=FLDSEP_ENCODE
|
|
S VAFHLROL(3,1)=FLDSEP_$TR(ROLE(1),TMP," ")
|
|
S VAFHLROL(3,2,1)=CMPSEP_$TR(ROLE(2,1),TMP," ")
|
|
S VAFHLROL(3,2,2)=SUBSEP_$TR(ROLE(2,2),TMP," ")
|
|
S VAFHLROL(3,2,3)=SUBSEP_$TR(ROLE(2,3),TMP," ")
|
|
S VAFHLROL(3,3)=CMPSEP_$TR(ROLE(3),TMP," ")
|
|
S3C4 ;Alternate Role (seq #3, comp #4 - 6)
|
|
I ('$D(@PARAM@("ALTROLE"))) D G S4
|
|
.S VAFHLROL(3,4)=CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
|
|
;Use input value
|
|
S TMP=NULL_CMPSEP_NULL_CMPSEP_NULL
|
|
S ALTROLE=$G(@PARAM@("ALTROLE"),TMP)
|
|
S:(ALTROLE="") ALTROLE=TMP
|
|
S TMP=$P(ALTROLE,CMPSEP,1)
|
|
S:(TMP="") TMP=NULL
|
|
S VAFHLROL(3,4)=CMPSEP_TMP
|
|
S TMP=$P(ALTROLE,CMPSEP,2)
|
|
S:(TMP="") TMP=NULL
|
|
S VAFHLROL(3,5)=CMPSEP_TMP
|
|
S TMP=$P(ALTROLE,CMPSEP,3)
|
|
S:(TMP="") TMP=NULL
|
|
S VAFHLROL(3,6)=CMPSEP_TMP
|
|
S4 ;Role Person (seq #4)
|
|
I ($D(@PARAM@("PERSON"))) D G DONE
|
|
.;Use input value
|
|
.S PERSON=$G(@PARAM@("PERSON"),NULL)
|
|
.I ((PERSON="")!(PERSON=NULL)) D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")
|
|
.S TMP=$P(PERSON,CMPSEP,1)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(4,1)=FLDSEP_TMP
|
|
.S TMP=$P(PERSON,CMPSEP,2)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(4,2)=CMPSEP_TMP
|
|
.S TMP=$P(PERSON,CMPSEP,3)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(4,3)=CMPSEP_TMP
|
|
.S TMP=$P(PERSON,CMPSEP,4)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(4,4)=CMPSEP_TMP
|
|
.S TMP=$P(PERSON,CMPSEP,5)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(4,5)=CMPSEP_TMP
|
|
.S TMP=$P(PERSON,CMPSEP,6)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(4,6)=CMPSEP_TMP
|
|
.S TMP=$P(PERSON,CMPSEP,7)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(4,7)=CMPSEP_TMP
|
|
.S TMP=$P(PERSON,CMPSEP,8)
|
|
.S:(TMP="") TMP=NULL
|
|
.S VAFHLROL(4,8)=CMPSEP_TMP
|
|
;Calculate value
|
|
I ('PTR200) D G DONE
|
|
.D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")
|
|
.S VAFHLROL(4)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
|
|
K PERSON D PERSON^VAFHLRO3(PTR200,"PERSON",NULL)
|
|
I ('$D(PERSON)) D G DONE
|
|
.D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")
|
|
.S VAFHLROL(4)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
|
|
;Strip out external values
|
|
I (CODEONLY) F TMP=2:1:7 S PERSON(1,TMP)=NULL
|
|
;Copy and add appropriate seperators
|
|
; (Convert any HL7 characters into spaces)
|
|
S TMP=FLDSEP_ENCODE
|
|
S VAFHLROL(4,1,1,1)=FLDSEP_$TR(PERSON(1,1,1),TMP," ")
|
|
S VAFHLROL(4,1,1,2)=SUBSEP_$TR(PERSON(1,1,2),TMP," ")
|
|
S VAFHLROL(4,1,2)=CMPSEP_$TR(PERSON(1,2),TMP," ")
|
|
S VAFHLROL(4,1,3)=CMPSEP_$TR(PERSON(1,3),TMP," ")
|
|
S VAFHLROL(4,1,4)=CMPSEP_$TR(PERSON(1,4),TMP," ")
|
|
S VAFHLROL(4,1,5)=CMPSEP_$TR(PERSON(1,5),TMP," ")
|
|
S VAFHLROL(4,1,6)=CMPSEP_$TR(PERSON(1,6),TMP," ")
|
|
S VAFHLROL(4,1,7)=CMPSEP_$TR(PERSON(1,7),TMP," ")
|
|
S VAFHLROL(4,1,8)=CMPSEP_$TR(PERSON(1,8),TMP," ")
|
|
S VAFHLROL(4,2,1)=REPSEP_$TR(PERSON(2,1),TMP," ")
|
|
F TMP=1:1:7 S VAFHLROL(4,2,TMP+1)=CMPSEP_$TR(PERSON(2,TMP+1),TMP," ")
|
|
S VAFHLROL(4,2,9)=CMPSEP_$TR(PERSON(2,9),TMP," ")
|
|
DONE ;Collapse into output location
|
|
D FIXLEN^VAFHLRO1("VAFHLROL",OUTARR,MAXLEN,0)
|
|
;Done
|
|
Q
|