SCMSVZSC ;ALB/ESD HL7 ZSC Segment Validation ;05/08/95
;;5.3;Scheduling;**44,66,143**;Aug 13, 1993
;
;
EN(ZSCARRY,HLQ,HLFS,VALERR,ENCPTR) ;
; Entry point to return the HL7 ZSC (Stop Code) validation segment
;
; Input: ZSCARRY - Array of ZSC Segments
; HLQ - HL7 null variable
; HLFS - HL7 field separator
;
;
; Output: 1 if ZSC passed validity check
; Error message if ZSC failed validity check in form of:
; -1^"xxx failed validity check" (xxx=element in ZSC segment)
;
;
N I,J,MSG,VALID,X,Z,ZSCSEG,CNT,SEG,SCSETID,DATA
S MSG="-1^Element in ZSC segment failed validity check"
S I=0,X="",ZSCARRY=$G(ZSCARRY),SEG="ZSC",(SCSETID,CNT)=1
S:(ZSCARRY="") ZSCARRY="^TMP(""VAFHL"",$J,""STOPCODE"")"
;
F S I=+$O(@ZSCARRY@(I)) Q:'I D
. S J="",VALID(1)=1
. F S J=$O(@ZSCARRY@(I,J)) Q:J="" D
.. S ZSCSEG=$G(@ZSCARRY@(I,J)),ZSCSEG=$$CONVERT^SCMSVUT0(ZSCSEG,HLFS,HLQ)
.. D VALIDATE^SCMSVUT0(SEG,ZSCSEG,"0013",VALERR,.CNT)
.. I $G(@VALERR@(SEG,CNT-1))="0013" Q
.. F Z=1,2,3,31 DO
... S DATA=$P(ZSCSEG,HLFS,+$E(Z,1,1))
... I Z=31 S DATA=$$STPCOD(DATA,ENCPTR)
... D VALIDATE^SCMSVUT0(SEG,DATA,$P($T(@(Z)),";",3),VALERR,.CNT)
...Q
..Q
.Q
;
I '$D(VALID) D VALIDATE^SCMSVUT0(SEG,"","0013",VALERR,.CNT)
;
ENQ Q $S($D(@VALERR@(SEG)):MSG,1:1)
;
;
;- ZSC data elements validated
;
STPCOD(DATA,ENCPTR) ;
N LP,ANS,STPARY
D SCODE^SCDXUTL0(ENCPTR,"STPARY")
I '$G(STPARY(0)) Q 0
S ANS=0
F LP=0:0 S LP=$O(STPARY(LP)) Q:'LP DO Q:+ANS>0
.N STPNOD
.S STPNOD=$G(^DIC(40.7,STPARY(LP),0))
.Q:STPNOD=""
.I $P(STPNOD,U,2)=DATA S ANS=+STPARY(LP)
.Q
Q ANS
;
1 ;;0035;HL7 SEGMENT NAME
2 ;;A050;HL7 SEQUENTIAL NUMBER (SET ID)
3 ;;A000;STOP CODE
31 ;;A020;INACTIVE STOP CODE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSVZSC 1796 printed Dec 13, 2024@02:42:17 Page 2
SCMSVZSC ;ALB/ESD HL7 ZSC Segment Validation ;05/08/95
+1 ;;5.3;Scheduling;**44,66,143**;Aug 13, 1993
+2 ;
+3 ;
EN(ZSCARRY,HLQ,HLFS,VALERR,ENCPTR) ;
+1 ; Entry point to return the HL7 ZSC (Stop Code) validation segment
+2 ;
+3 ; Input: ZSCARRY - Array of ZSC Segments
+4 ; HLQ - HL7 null variable
+5 ; HLFS - HL7 field separator
+6 ;
+7 ;
+8 ; Output: 1 if ZSC passed validity check
+9 ; Error message if ZSC failed validity check in form of:
+10 ; -1^"xxx failed validity check" (xxx=element in ZSC segment)
+11 ;
+12 ;
+13 NEW I,J,MSG,VALID,X,Z,ZSCSEG,CNT,SEG,SCSETID,DATA
+14 SET MSG="-1^Element in ZSC segment failed validity check"
+15 SET I=0
SET X=""
SET ZSCARRY=$GET(ZSCARRY)
SET SEG="ZSC"
SET (SCSETID,CNT)=1
+16 if (ZSCARRY="")
SET ZSCARRY="^TMP(""VAFHL"",$J,""STOPCODE"")"
+17 ;
+18 FOR
SET I=+$ORDER(@ZSCARRY@(I))
if 'I
QUIT
Begin DoDot:1
+19 SET J=""
SET VALID(1)=1
+20 FOR
SET J=$ORDER(@ZSCARRY@(I,J))
if J=""
QUIT
Begin DoDot:2
+21 SET ZSCSEG=$GET(@ZSCARRY@(I,J))
SET ZSCSEG=$$CONVERT^SCMSVUT0(ZSCSEG,HLFS,HLQ)
+22 DO VALIDATE^SCMSVUT0(SEG,ZSCSEG,"0013",VALERR,.CNT)
+23 IF $GET(@VALERR@(SEG,CNT-1))="0013"
QUIT
+24 FOR Z=1,2,3,31
Begin DoDot:3
+25 SET DATA=$PIECE(ZSCSEG,HLFS,+$EXTRACT(Z,1,1))
+26 IF Z=31
SET DATA=$$STPCOD(DATA,ENCPTR)
+27 DO VALIDATE^SCMSVUT0(SEG,DATA,$PIECE($TEXT(@(Z)),";",3),VALERR,.CNT)
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 ;
+32 IF '$DATA(VALID)
DO VALIDATE^SCMSVUT0(SEG,"","0013",VALERR,.CNT)
+33 ;
ENQ QUIT $SELECT($DATA(@VALERR@(SEG)):MSG,1:1)
+1 ;
+2 ;
+3 ;- ZSC data elements validated
+4 ;
STPCOD(DATA,ENCPTR) ;
+1 NEW LP,ANS,STPARY
+2 DO SCODE^SCDXUTL0(ENCPTR,"STPARY")
+3 IF '$GET(STPARY(0))
QUIT 0
+4 SET ANS=0
+5 FOR LP=0:0
SET LP=$ORDER(STPARY(LP))
if 'LP
QUIT
Begin DoDot:1
+6 NEW STPNOD
+7 SET STPNOD=$GET(^DIC(40.7,STPARY(LP),0))
+8 if STPNOD=""
QUIT
+9 IF $PIECE(STPNOD,U,2)=DATA
SET ANS=+STPARY(LP)
+10 QUIT
End DoDot:1
if +ANS>0
QUIT
+11 QUIT ANS
+12 ;
1 ;;0035;HL7 SEGMENT NAME
2 ;;A050;HL7 SEQUENTIAL NUMBER (SET ID)
3 ;;A000;STOP CODE
31 ;;A020;INACTIVE STOP CODE
