ABSPECR2 ; IHS/FCS/DRS - JWS 10:24 AM 19 Dec 1995 ; [ 09/12/2002 10:00 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;NCPDP Record Print-Out
; Why this and not ABSPECR1? Don't know.
; Just carrying it along for now.
;----------------------------------------------------------------------
EN1 ;
;Open 10:(MODE="W":FILE="A:NCPDP-R.TXT")
;Use 10
;S NEXTIEN=0
;F D Q:'+NEXTIEN
;.S NEXTIEN=$ORDER(^ABSPF(9002313.92,NEXTIEN))
;.Q:'+NEXTIEN
;.D R2(NEXTIEN)
S NEXTIEN=8
D R2(NEXTIEN)
;Close 10
Q
;----------------------------------------------------------------------
EN2(NEXTIEN) ;
;Open 10:(MODE="W":FILE="A:NCPDP-R.TXT")
;Use 10
D R2(NEXTIEN)
;Close 10
Q
;---------------------------------------------------------------------
R2(IEN) ;EP -
N FDATA,FIEN,GCODE,GN,MDATA,MIEN,NODE,ORDER,RDATA,XFLAG
N POSITION,LENGTH,GSPOS S POSITION=1
N IENS S IENS=IEN_","
I '$G(IOM) N IOM S IOM=80
D R2HEADER(IEN)
F NODE=10,20,30,40 D
.W !
.I NODE=10 W "Claim Header (Required) Record:",!!
.I NODE=20 W "Claim Header (Optional) Record:",!!
.I NODE=30 D
. . I '$$GET1^DIQ(9002313.92,IENS,1.07,"I") D
. . . D GS W !
. . . S GSPOS=POSITION
. . W "Claim Information (Required) Record:",!!
.I NODE=40 W "Claim Information (Optional) Record:",!!
.S ORDER=0
.F D Q:'+ORDER
..S ORDER=$ORDER(^ABSPF(9002313.92,IEN,NODE,"B",ORDER))
..Q:'+ORDER
..S MIEN=$ORDER(^ABSPF(9002313.92,IEN,NODE,"B",ORDER,""))
..Q:'+MIEN
..S MDATA=$G(^ABSPF(9002313.92,IEN,NODE,MIEN,0))
..I $P(MDATA,U,3)="" S $P(MDATA,U,3)="S" ; defaults to Standard mode
..S FIEN=$P(MDATA,U,2)
..Q:'+FIEN
..S FDATA=$G(^ABSPF(9002313.91,FIEN,0))
..S LENGTH=$P(FDATA,U,5)
..I NODE=20!(NODE=40) S LENGTH=LENGTH+3
..S:$P(MDATA,U,3)="X" XFLAG(NODE,MIEN)=FIEN
..W $J(ORDER,3)," "
..W $J($P(FDATA,U,1),3)," "
..W $J(POSITION,3)
..I LENGTH>1 D
...W "-",$J(POSITION+LENGTH-1,3)
..E D
...W " "," "
..W " "
..S POSITION=POSITION+LENGTH
..W $P(MDATA,U,3)," "
..W $P(FDATA,U,3),!
;W !,"Total length of claim record: ",POSITION-1," bytes",!
; more claims in the same packet, maybe
I $G(GSPOS) N CLAIMLEN S CLAIMLEN=POSITION-GSPOS ; length of one claim
F N=2:1:$$GET1^DIQ(9002313.92,IENS,1.03) D CLAIM(N)
;W #
D:$D(XFLAG)
.;D R2HEADER(IEN)
.F NODE=10,20,30,40 D
..Q:'$D(XFLAG(NODE))
..W !
..S MIEN=""
..F D Q:'+MIEN
...S MIEN=$ORDER(XFLAG(NODE,MIEN))
...Q:'+MIEN
...S FIEN=$G(XFLAG(NODE,MIEN))
...Q:FIEN=""
...S RDATA=$G(^ABSPF(9002313.91,FIEN,0))
...Q:RDATA=""
...W $J($P(RDATA,U,1),3),?10,$P(RDATA,U,3),!
...S GN=0
...F D Q:'+GN
....S GN=$ORDER(^ABSPF(9002313.92,IEN,NODE,MIEN,1,GN))
....Q:'+GN
....S GCODE=$G(^ABSPF(9002313.92,IEN,NODE,MIEN,1,GN,0))
....W ?10,"X",GN,": ",GCODE,!
.W #
Q
GS ; where a group separator occurs
W " ",$J(POSITION,3)," "
W "Group Separator ($C(29))",!
S POSITION=POSITION+1
Q
CLAIM(N) ; where 2nd, 3rd, 4th claims go
W !
D GS ; a group separator comes first
W " ",$J(POSITION,3)
W "-",$J(POSITION+CLAIMLEN-1,3)," "
W "Claim #",N,!
S POSITION=POSITION+CLAIMLEN
Q
;----------------------------------------------------------------------
W $$GET1^DIQ(9002313.92,IENS,.01)
W " (`",IEN,")",!
W $TR($J("",IOM)," ","-"),!
I '$$GET1^DIQ(9002313.92,IENS,1.07,"I") D ; if not a reversal format
. N FIELD S FIELD=1
. F S FIELD=$O(^DD(9002313.92,FIELD)) Q:'FIELD D
. . I FIELD'<10,FIELD'>40 Q
. . I FIELD=1.07 Q ; "Is A Reversal Format"
. . W $$GET1^DID(9002313.92,FIELD,,"LABEL"),": "
. . W $$GET1^DIQ(9002313.92,IENS,FIELD)
. . W !
Q
ABSPECR2 ; IHS/FCS/DRS - JWS 10:24 AM 19 Dec 1995 ; [ 09/12/2002 10:00 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
+4 ;NCPDP Record Print-Out
+5 ; Why this and not ABSPECR1? Don't know.
+6 ; Just carrying it along for now.
+7 ;----------------------------------------------------------------------
EN1 ;
+1 ;Open 10:(MODE="W":FILE="A:NCPDP-R.TXT")
+2 ;Use 10
+3 ;S NEXTIEN=0
+4 ;F D Q:'+NEXTIEN
+5 ;.S NEXTIEN=$ORDER(^ABSPF(9002313.92,NEXTIEN))
+6 ;.Q:'+NEXTIEN
+7 ;.D R2(NEXTIEN)
+8 SET NEXTIEN=8
+9 DO R2(NEXTIEN)
+10 ;Close 10
+11 QUIT
+12 ;----------------------------------------------------------------------
EN2(NEXTIEN) ;
+1 ;Open 10:(MODE="W":FILE="A:NCPDP-R.TXT")
+2 ;Use 10
+3 DO R2(NEXTIEN)
+4 ;Close 10
+5 QUIT
+6 ;---------------------------------------------------------------------
R2(IEN) ;EP -
+1 NEW FDATA,FIEN,GCODE,GN,MDATA,MIEN,NODE,ORDER,RDATA,XFLAG
+2 NEW POSITION,LENGTH,GSPOS
SET POSITION=1
+3 NEW IENS
SET IENS=IEN_","
+4 IF '$GET(IOM)
NEW IOM
SET IOM=80
+5 DO R2HEADER(IEN)
+6 FOR NODE=10,20,30,40
Begin DoDot:1
+7 WRITE !
+8 IF NODE=10
WRITE "Claim Header (Required) Record:",!!
+9 IF NODE=20
WRITE "Claim Header (Optional) Record:",!!
+10 IF NODE=30
Begin DoDot:2
+11 IF '$$GET1^DIQ(9002313.92,IENS,1.07,"I")
Begin DoDot:3
+12 DO GS
WRITE !
+13 SET GSPOS=POSITION
End DoDot:3
+14 WRITE "Claim Information (Required) Record:",!!
End DoDot:2
+15 IF NODE=40
WRITE "Claim Information (Optional) Record:",!!
+16 SET ORDER=0
+17 FOR
Begin DoDot:2
+18 SET ORDER=$ORDER(^ABSPF(9002313.92,IEN,NODE,"B",ORDER))
+19 IF '+ORDER
QUIT
+20 SET MIEN=$ORDER(^ABSPF(9002313.92,IEN,NODE,"B",ORDER,""))
+21 IF '+MIEN
QUIT
+22 SET MDATA=$GET(^ABSPF(9002313.92,IEN,NODE,MIEN,0))
+23 ; defaults to Standard mode
IF $PIECE(MDATA,U,3)=""
SET $PIECE(MDATA,U,3)="S"
+24 SET FIEN=$PIECE(MDATA,U,2)
+25 IF '+FIEN
QUIT
+26 SET FDATA=$GET(^ABSPF(9002313.91,FIEN,0))
+27 SET LENGTH=$PIECE(FDATA,U,5)
+28 IF NODE=20!(NODE=40)
SET LENGTH=LENGTH+3
+29 IF $PIECE(MDATA,U,3)="X"
SET XFLAG(NODE,MIEN)=FIEN
+30 WRITE $JUSTIFY(ORDER,3)," "
+31 WRITE $JUSTIFY($PIECE(FDATA,U,1),3)," "
+32 WRITE $JUSTIFY(POSITION,3)
+33 IF LENGTH>1
Begin DoDot:3
+34 WRITE "-",$JUSTIFY(POSITION+LENGTH-1,3)
End DoDot:3
+35 IF '$TEST
Begin DoDot:3
+36 WRITE " "," "
End DoDot:3
+37 WRITE " "
+38 SET POSITION=POSITION+LENGTH
+39 WRITE $PIECE(MDATA,U,3)," "
+40 WRITE $PIECE(FDATA,U,3),!
End DoDot:2
IF '+ORDER
QUIT
End DoDot:1
+41 ;W !,"Total length of claim record: ",POSITION-1," bytes",!
+42 ; more claims in the same packet, maybe
+43 ; length of one claim
IF $GET(GSPOS)
NEW CLAIMLEN
SET CLAIMLEN=POSITION-GSPOS
+44 FOR N=2:1:$$GET1^DIQ(9002313.92,IENS,1.03)
DO CLAIM(N)
+45 ;W #
+46 IF $DATA(XFLAG)
Begin DoDot:1
+47 ;D R2HEADER(IEN)
+48 FOR NODE=10,20,30,40
Begin DoDot:2
+49 IF '$DATA(XFLAG(NODE))
QUIT
+50 WRITE !
+51 SET MIEN=""
+52 FOR
Begin DoDot:3
+53 SET MIEN=$ORDER(XFLAG(NODE,MIEN))
+54 IF '+MIEN
QUIT
+55 SET FIEN=$GET(XFLAG(NODE,MIEN))
+56 IF FIEN=""
QUIT
+57 SET RDATA=$GET(^ABSPF(9002313.91,FIEN,0))
+58 IF RDATA=""
QUIT
+59 WRITE $JUSTIFY($PIECE(RDATA,U,1),3),?10,$PIECE(RDATA,U,3),!
+60 SET GN=0
+61 FOR
Begin DoDot:4
+62 SET GN=$ORDER(^ABSPF(9002313.92,IEN,NODE,MIEN,1,GN))
+63 IF '+GN
QUIT
+64 SET GCODE=$GET(^ABSPF(9002313.92,IEN,NODE,MIEN,1,GN,0))
+65 WRITE ?10,"X",GN,": ",GCODE,!
End DoDot:4
IF '+GN
QUIT
End DoDot:3
IF '+MIEN
QUIT
End DoDot:2
+66 WRITE #
End DoDot:1
+67 QUIT
GS ; where a group separator occurs
+1 WRITE " ",$JUSTIFY(POSITION,3)," "
+2 WRITE "Group Separator ($C(29))",!
+3 SET POSITION=POSITION+1
+4 QUIT
CLAIM(N) ; where 2nd, 3rd, 4th claims go
+1 WRITE !
+2 ; a group separator comes first
DO GS
+3 WRITE " ",$JUSTIFY(POSITION,3)
+4 WRITE "-",$JUSTIFY(POSITION+CLAIMLEN-1,3)," "
+5 WRITE "Claim #",N,!
+6 SET POSITION=POSITION+CLAIMLEN
+7 QUIT
+8 ;----------------------------------------------------------------------
+1 WRITE $$GET1^DIQ(9002313.92,IENS,.01)
+2 WRITE " (`",IEN,")",!
+3 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","-"),!
+4 ; if not a reversal format
IF '$$GET1^DIQ(9002313.92,IENS,1.07,"I")
Begin DoDot:1
+5 NEW FIELD
SET FIELD=1
+6 FOR
SET FIELD=$ORDER(^DD(9002313.92,FIELD))
IF 'FIELD
QUIT
Begin DoDot:2
+7 IF FIELD'<10
IF FIELD'>40
QUIT
+8 ; "Is A Reversal Format"
IF FIELD=1.07
QUIT
+9 WRITE $$GET1^DID(9002313.92,FIELD,,"LABEL"),": "
+10 WRITE $$GET1^DIQ(9002313.92,IENS,FIELD)
+11 WRITE !
End DoDot:2
End DoDot:1
+12 QUIT
