- ABME8TOO ; IHS/ASDST/DMJ - 837 TOO Segment
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Tooth Identification
- ;
- ; IHS/SD/SDR - v2.5 p10 - IM20395
- ; Split out lines bundled by rev code
- ;
- ;EP - START HERE
- K ABMREC("TOO"),ABMR("TOO")
- S ABME("RTYPE")="TOO"
- D LOOP
- K ABME,ABM
- Q
- LOOP ;LOOP HERE
- F I=10:10:40 D
- .D @I
- .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))
- .I $G(ABMREC("TOO"))'="" S ABMREC("TOO")=ABMREC("TOO")_"*"
- .S ABMREC("TOO")=$G(ABMREC("TOO"))_ABMR("TOO",I)
- Q
- 10 ;segment
- S ABMR("TOO",10)="TOO"
- Q
- 20 ;TOO01 - Code List Qualifier Code
- S ABMR("TOO",20)="JP"
- Q
- 30 ;TOO02 - Tooth Number
- N I
- S I=$P(ABMRV(ABMI,ABMJ,ABMK),U,23)
- S ABMR("TOO",30)=$G(^ADEOPS(+I,88))
- Q
- 40 ;TOO03 - Tooth Surface
- N I,J
- S I=$P(ABMRV(ABMI,ABMJ,ABMK),U,24)
- I I="" S ABMR("TOO",40)="" Q
- F J=1:1:$L(I) D
- .S $P(ABMR("TOO",40),":",J)=$E(I,J)
- Q
- ABME8TOO ; IHS/ASDST/DMJ - 837 TOO Segment
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;Tooth Identification
- +3 ;
- +4 ; IHS/SD/SDR - v2.5 p10 - IM20395
- +5 ; Split out lines bundled by rev code
- +6 ;
- +7 ;EP - START HERE
- +8 KILL ABMREC("TOO"),ABMR("TOO")
- +9 SET ABME("RTYPE")="TOO"
- +10 DO LOOP
- +11 KILL ABME,ABM
- +12 QUIT
- LOOP ;LOOP HERE
- +1 FOR I=10:10:40
- 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("TOO"))'=""
- SET ABMREC("TOO")=ABMREC("TOO")_"*"
- +5 SET ABMREC("TOO")=$GET(ABMREC("TOO"))_ABMR("TOO",I)
- End DoDot:1
- +6 QUIT
- 10 ;segment
- +1 SET ABMR("TOO",10)="TOO"
- +2 QUIT
- 20 ;TOO01 - Code List Qualifier Code
- +1 SET ABMR("TOO",20)="JP"
- +2 QUIT
- 30 ;TOO02 - Tooth Number
- +1 NEW I
- +2 SET I=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,23)
- +3 SET ABMR("TOO",30)=$GET(^ADEOPS(+I,88))
- +4 QUIT
- 40 ;TOO03 - Tooth Surface
- +1 NEW I,J
- +2 SET I=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,24)
- +3 IF I=""
- SET ABMR("TOO",40)=""
- QUIT
- +4 FOR J=1:1:$LENGTH(I)
- Begin DoDot:1
- +5 SET $PIECE(ABMR("TOO",40),":",J)=$EXTRACT(I,J)
- End DoDot:1
- +6 QUIT