ABME8HL.m

ABME8HL ; IHS/ASDST/DMJ - 837 HL Segment 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Hierarchical Level

 ;

EP(X,Y) ;EP - START HERE

 ;x=level

 ;y=child code

 K ABMREC("HL"),ABMR("HL")

 S ABMHL=X

 S ABMCHILD=Y

 S ABMHLCNT=+$G(ABMHLCNT)+1

 S ABMHL(ABMHL)=ABMHLCNT

 S ABME("RTYPE")="HL"

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:50 D

 .D @I

 .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))

 .I $G(ABMREC("HL"))'="" S ABMREC("HL")=ABMREC("HL")_"*"

 .S ABMREC("HL")=$G(ABMREC("HL"))_ABMR("HL",I)

 Q

10 ;segment

 S ABMR("HL",10)="HL"

 Q

20 ;HL01 - Hierarchical ID Number

 S ABMR("HL",20)=ABMHLCNT

 Q

30 ;HL02 - Hierarchical Parent ID Number

 S ABMR("HL",30)=$O(ABMHL(ABMHL),-1)

 S ABMR("HL",30)=$G(ABMHL(+ABMR("HL",30)))

 Q

40 ;HL03 - Hierarchical Level Code

 S ABMR("HL",40)=ABMHL

 Q

50 ;HL04 - Hierarchical Child Code

 S ABMR("HL",50)=ABMCHILD

 Q

ABME8HL   ; IHS/ASDST/DMJ - 837 HL Segment 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Hierarchical Level

 +3       ;

EP(X,Y)   ;EP - START HERE

 +1       ;x=level

 +2       ;y=child code

 +3        KILL ABMREC("HL"),ABMR("HL")

 +4        SET ABMHL=X

 +5        SET ABMCHILD=Y

 +6        SET ABMHLCNT=+$GET(ABMHLCNT)+1

 +7        SET ABMHL(ABMHL)=ABMHLCNT

 +8        SET ABME("RTYPE")="HL"

 +9        DO LOOP

 +10       KILL ABME,ABM

 +11       QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:50

               Begin DoDot:1

 +2                DO @I

 +3                IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),ABME("RTYPE"),I))

                       DO @(^(I))

 +4                IF $GET(ABMREC("HL"))'=""

                       SET ABMREC("HL")=ABMREC("HL")_"*"

 +5                SET ABMREC("HL")=$GET(ABMREC("HL"))_ABMR("HL",I)

               End DoDot:1

 +6        QUIT 

10        ;segment

 +1        SET ABMR("HL",10)="HL"

 +2        QUIT 

20        ;HL01 - Hierarchical ID Number

 +1        SET ABMR("HL",20)=ABMHLCNT

 +2        QUIT 

30        ;HL02 - Hierarchical Parent ID Number

 +1        SET ABMR("HL",30)=$ORDER(ABMHL(ABMHL),-1)

 +2        SET ABMR("HL",30)=$GET(ABMHL(+ABMR("HL",30)))

 +3        QUIT 

40        ;HL03 - Hierarchical Level Code

 +1        SET ABMR("HL",40)=ABMHL

 +2        QUIT 

50        ;HL04 - Hierarchical Child Code

 +1        SET ABMR("HL",50)=ABMCHILD

 +2        QUIT