SCMSVROL ;BP/JRP - HL7 ROL Segment Validation;6-MAR-1998
;;5.3;Scheduling;**142,245**;Aug 13, 1993
;
;
EN(ROLARRY,HLQ,HLFS,HLECH,VALERR) ;Entry point to validate all HL7 ROL
; (Role) segments built for message
;
;Input : ROLARRY - Array of ROL Segments
; HLQ - HL7 null designation
; HLFS - HL7 field separator
; HLECH - HL7 encouding characters
; VALERR - Array to return error list in (full global reference)
;
;Output: 1 - All ROL segments passed validity checks
; -1^Text - One/many/all ROL segments failed validity checks
; List of errors returned as follows:
; VALERR("ROL",x) = Error Code
;Notes : Initialization of VALERR() is the reponsibility of the
; calling program
; : Existance/validity of input is assumed
;
;Declare variables
N LOOP1,CNT,MSG,PRIMECNT,TMP,SCMSVROL,PRIME
S MSG="-1^Element in ROL segment failed validity check"
S PRIMECNT=0
;Loop through array of ROL segments
S LOOP1=0
F S LOOP1=+$O(@ROLARRY@(LOOP1)) Q:('LOOP1) D
.;Validate individual segment
.S TMP=$$EN1($NA(@ROLARRY@(LOOP1)),HLQ,HLFS,HLECH,VALERR,.PRIME)
.;Track total number of primary providers designated
.I PRIME S PRIMECNT=PRIMECNT+1
;Make logic in D050 only allow the number 1
S SCMSVROL=1
;Validate number of primary providers designated (must be 1)
S CNT=1+$O(@VALERR@("ROL",""),-1)
D VALIDATE^SCMSVUT0("ROL",PRIMECNT,"D050",VALERR,.CNT)
ENQ Q $S($D(@VALERR@("ROL")):MSG,1:1)
;
EN1(ROLSEG,HLQ,HLFS,HLECH,VALERR,PRIME) ;Entry point to validate the HL7 ROL
; (Role) segment
;
;Input : ROLSEG - Array containing ROL Segment (full global reference)
; ROLSEG = First 245 characters
; ROLSEG(x) = Continuation nodes
; HLQ - HL7 null designation
; HLFS - HL7 field separator
; HLECH - HL7 encoding characters
; VALERR - Array to return error list in (full global reference)
; PRIME - Output variable (pass by reference)
;
;Output: 1 - ROL segment passed validity checks
; -1^Text - ROL segment failed validity checks
; List of errors returned as follows:
; VALERR("ROL",x) = Error Code
; PRIME = 1 if primary encounter provider
; PRIME = 0 if not primary encounter provider
;Notes : Initialization of VALERR() is the reponsibility of the
; calling program
; : Existance/validity of input is assumed
;
;Declare variables
N SEG,MSG,CNT,TMP,PARSEG,OLDCNT,CMPSEP,SCMSVROL,LOOP,CODE,CHECK
S MSG="-1^Element in ROL segment failed validity check"
S (OLDCNT,CNT)=1+$O(@VALERR@("ROL",""),-1)
S PRIME=0
;Parse out fields
S TMP("FS")=HLFS,TMP("ECH")=HLECH,TMP("Q")=HLQ
D PARSEG^SCMSVUT4(ROLSEG,"PARSEG",.TMP,0,1)
I PARSEG(0)'="ROL" D VALIDATE^SCMSVUT0("ROL","","0370",VALERR,.CNT) G EN1Q
;Remember component separator
S CMPSEP=$E(HLECH,1)
;Primary care provider ?
S DATA=$G(PARSEG(3,1))
S:($P(DATA,CMPSEP,4)=1) PRIME=1
;Make logic in D050 allow numbers 0 and 1
S SCMSVROL=0
;Validate
S CODE=""
F LOOP=1:1 D Q:CODE=""
.S DATA=$T(ERRORS+LOOP)
.S CODE=$P(DATA,";",3)
.Q:(CODE="")
.S CHECK=$P(DATA,";",1)
.S DATA=$G(PARSEG(+$E(CHECK,1,2),+$E(CHECK,3,4)))
.S DATA=$P(DATA,CMPSEP,+$E(CHECK,5,6),+$E(CHECK,7,8))
.D VALIDATE^SCMSVUT0("ROL",DATA,CODE,VALERR,.CNT)
EN1Q Q $S(CNT'=OLDCNT:MSG,1:1)
;
;Line tag format is SSRRBCEC
; SS=sequence, RR=repetition
; BC=begining component, EC=ending component
ERRORS ;Data elements validated
01010101 ;;D150;ROLE INSTANCE ID
03010101 ;;D000;PROVIDER TYPE CODE
03010404 ;;D050;PRIMARY ENCOUNTER PROVIDER DESIGNATION
04010101 ;;D070;INVALID PROVIDER ID
04010207 ;;D130;PROVIDER NAME
04020101 ;;D140;PROVIDER SSN
;;
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSVROL 3817 printed Oct 16, 2024@18:42:43 Page 2
SCMSVROL ;BP/JRP - HL7 ROL Segment Validation;6-MAR-1998
+1 ;;5.3;Scheduling;**142,245**;Aug 13, 1993
+2 ;
+3 ;
EN(ROLARRY,HLQ,HLFS,HLECH,VALERR) ;Entry point to validate all HL7 ROL
+1 ; (Role) segments built for message
+2 ;
+3 ;Input : ROLARRY - Array of ROL Segments
+4 ; HLQ - HL7 null designation
+5 ; HLFS - HL7 field separator
+6 ; HLECH - HL7 encouding characters
+7 ; VALERR - Array to return error list in (full global reference)
+8 ;
+9 ;Output: 1 - All ROL segments passed validity checks
+10 ; -1^Text - One/many/all ROL segments failed validity checks
+11 ; List of errors returned as follows:
+12 ; VALERR("ROL",x) = Error Code
+13 ;Notes : Initialization of VALERR() is the reponsibility of the
+14 ; calling program
+15 ; : Existance/validity of input is assumed
+16 ;
+17 ;Declare variables
+18 NEW LOOP1,CNT,MSG,PRIMECNT,TMP,SCMSVROL,PRIME
+19 SET MSG="-1^Element in ROL segment failed validity check"
+20 SET PRIMECNT=0
+21 ;Loop through array of ROL segments
+22 SET LOOP1=0
+23 FOR
SET LOOP1=+$ORDER(@ROLARRY@(LOOP1))
if ('LOOP1)
QUIT
Begin DoDot:1
+24 ;Validate individual segment
+25 SET TMP=$$EN1($NAME(@ROLARRY@(LOOP1)),HLQ,HLFS,HLECH,VALERR,.PRIME)
+26 ;Track total number of primary providers designated
+27 IF PRIME
SET PRIMECNT=PRIMECNT+1
End DoDot:1
+28 ;Make logic in D050 only allow the number 1
+29 SET SCMSVROL=1
+30 ;Validate number of primary providers designated (must be 1)
+31 SET CNT=1+$ORDER(@VALERR@("ROL",""),-1)
+32 DO VALIDATE^SCMSVUT0("ROL",PRIMECNT,"D050",VALERR,.CNT)
ENQ QUIT $SELECT($DATA(@VALERR@("ROL")):MSG,1:1)
+1 ;
EN1(ROLSEG,HLQ,HLFS,HLECH,VALERR,PRIME) ;Entry point to validate the HL7 ROL
+1 ; (Role) segment
+2 ;
+3 ;Input : ROLSEG - Array containing ROL Segment (full global reference)
+4 ; ROLSEG = First 245 characters
+5 ; ROLSEG(x) = Continuation nodes
+6 ; HLQ - HL7 null designation
+7 ; HLFS - HL7 field separator
+8 ; HLECH - HL7 encoding characters
+9 ; VALERR - Array to return error list in (full global reference)
+10 ; PRIME - Output variable (pass by reference)
+11 ;
+12 ;Output: 1 - ROL segment passed validity checks
+13 ; -1^Text - ROL segment failed validity checks
+14 ; List of errors returned as follows:
+15 ; VALERR("ROL",x) = Error Code
+16 ; PRIME = 1 if primary encounter provider
+17 ; PRIME = 0 if not primary encounter provider
+18 ;Notes : Initialization of VALERR() is the reponsibility of the
+19 ; calling program
+20 ; : Existance/validity of input is assumed
+21 ;
+22 ;Declare variables
+23 NEW SEG,MSG,CNT,TMP,PARSEG,OLDCNT,CMPSEP,SCMSVROL,LOOP,CODE,CHECK
+24 SET MSG="-1^Element in ROL segment failed validity check"
+25 SET (OLDCNT,CNT)=1+$ORDER(@VALERR@("ROL",""),-1)
+26 SET PRIME=0
+27 ;Parse out fields
+28 SET TMP("FS")=HLFS
SET TMP("ECH")=HLECH
SET TMP("Q")=HLQ
+29 DO PARSEG^SCMSVUT4(ROLSEG,"PARSEG",.TMP,0,1)
+30 IF PARSEG(0)'="ROL"
DO VALIDATE^SCMSVUT0("ROL","","0370",VALERR,.CNT)
GOTO EN1Q
+31 ;Remember component separator
+32 SET CMPSEP=$EXTRACT(HLECH,1)
+33 ;Primary care provider ?
+34 SET DATA=$GET(PARSEG(3,1))
+35 if ($PIECE(DATA,CMPSEP,4)=1)
SET PRIME=1
+36 ;Make logic in D050 allow numbers 0 and 1
+37 SET SCMSVROL=0
+38 ;Validate
+39 SET CODE=""
+40 FOR LOOP=1:1
Begin DoDot:1
+41 SET DATA=$TEXT(ERRORS+LOOP)
+42 SET CODE=$PIECE(DATA,";",3)
+43 if (CODE="")
QUIT
+44 SET CHECK=$PIECE(DATA,";",1)
+45 SET DATA=$GET(PARSEG(+$EXTRACT(CHECK,1,2),+$EXTRACT(CHECK,3,4)))
+46 SET DATA=$PIECE(DATA,CMPSEP,+$EXTRACT(CHECK,5,6),+$EXTRACT(CHECK,7,8))
+47 DO VALIDATE^SCMSVUT0("ROL",DATA,CODE,VALERR,.CNT)
End DoDot:1
if CODE=""
QUIT
EN1Q QUIT $SELECT(CNT'=OLDCNT:MSG,1:1)
+1 ;
+2 ;Line tag format is SSRRBCEC
+3 ; SS=sequence, RR=repetition
+4 ; BC=begining component, EC=ending component
ERRORS ;Data elements validated
01010101 ;;D150;ROLE INSTANCE ID
03010101 ;;D000;PROVIDER TYPE CODE
03010404 ;;D050;PRIMARY ENCOUNTER PROVIDER DESIGNATION
04010101 ;;D070;INVALID PROVIDER ID
04010207 ;;D130;PROVIDER NAME
04020101 ;;D140;PROVIDER SSN
+1 ;;
+2 ;;
