ABSPECR1 ; IHS/FCS/DRS - JWS 10:21 AM 6 Dec 1995 ; [ 09/12/2002 9:59 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;NCPDP Record Print-Out
; EN to print all formats
; R2^ABSPECR1(ien) to print just one format
;----------------------------------------------------------------------
EN N POP,NEXTIEN
D ^%ZIS Q:$G(POP)
U IO
S NEXTIEN=0
F D Q:'+NEXTIEN
.S NEXTIEN=$O(^ABSPF(9002313.92,NEXTIEN))
.Q:'+NEXTIEN
.D R2(NEXTIEN)
D ^%ZISC
Q
;---------------------------------------------------------------------
R2(IEN) ;
D R2^ABSPECR2(IEN)
Q
; the rest of this was pretty much duplicated in ABSPECR2
; we enhanced what was there, too.
; so what follows is obsolete and can be deleted
N FD,FIEN,GCODE,GN,MD,MIEN,NODE,O,RD,XFLAG
Q:IEN=""
Q:$D(^ABSPF(9002313.92,IEN,0))=0
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 W "Claim Information (Required) Record:",!!
.I NODE=40 W "Claim Information (Optional) Record:",!!
.S O=0
.F D Q:'+O
..S O=$O(^ABSPF(9002313.92,IEN,NODE,"B",O))
..Q:'+O
..S MIEN=$O(^ABSPF(9002313.92,IEN,NODE,"B",O,""))
..Q:'+MIEN
..S MD=$G(^ABSPF(9002313.92,IEN,NODE,MIEN,0))
..S FIEN=$P(MD,U,2)
..Q:'+FIEN
..S FD=$G(^ABSPF(9002313.91,FIEN,0))
..S:$P(MD,U,3)="X" XFLAG(NODE,MIEN)=FIEN
..W $J(O,3)," ",$J($P(FD,U,1),3)," ",$P(MD,U,3)," ",$P(FD,U,3),!
H 1
W @IOF
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=$O(XFLAG(NODE,MIEN))
...Q:'+MIEN
...S FIEN=$G(XFLAG(NODE,MIEN))
...Q:FIEN=""
...S RD=$G(^ABSPF(9002313.91,FIEN,0))
...Q:RD=""
...W !,$J($P(RD,U,1),3),?10,$P(RD,U,3),!
...S GN=0
...F D Q:'+GN
....S GN=$O(^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,!
.H 1
.W @IOF
Q
;----------------------------------------------------------------------
W "NCPDP Record Definition"
W $$RJBF^ABSPECFM($P($G(^ABSPF(9002313.92,IEN,0)),U,1),IOM-23),!
W $TR($J("",IOM)," ","-"),!
Q
ABSPECR1 ; IHS/FCS/DRS - JWS 10:21 AM 6 Dec 1995 ; [ 09/12/2002 9:59 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
+4 ;NCPDP Record Print-Out
+5 ; EN to print all formats
+6 ; R2^ABSPECR1(ien) to print just one format
+7 ;----------------------------------------------------------------------
EN NEW POP,NEXTIEN
+1 DO ^%ZIS
IF $GET(POP)
QUIT
+2 USE IO
+3 SET NEXTIEN=0
+4 FOR
Begin DoDot:1
+5 SET NEXTIEN=$ORDER(^ABSPF(9002313.92,NEXTIEN))
+6 IF '+NEXTIEN
QUIT
+7 DO R2(NEXTIEN)
End DoDot:1
IF '+NEXTIEN
QUIT
+8 DO ^%ZISC
+9 QUIT
+10 ;---------------------------------------------------------------------
R2(IEN) ;
+1 DO R2^ABSPECR2(IEN)
+2 QUIT
+3 ; the rest of this was pretty much duplicated in ABSPECR2
+4 ; we enhanced what was there, too.
+5 ; so what follows is obsolete and can be deleted
+6 NEW FD,FIEN,GCODE,GN,MD,MIEN,NODE,O,RD,XFLAG
+7 IF IEN=""
QUIT
+8 IF $DATA(^ABSPF(9002313.92,IEN,0))=0
QUIT
+9 DO R2HEADER(IEN)
+10 FOR NODE=10,20,30,40
Begin DoDot:1
+11 WRITE !
+12 IF NODE=10
WRITE "Claim Header (Required) Record:",!!
+13 IF NODE=20
WRITE "Claim Header (Optional) Record:",!!
+14 IF NODE=30
WRITE "Claim Information (Required) Record:",!!
+15 IF NODE=40
WRITE "Claim Information (Optional) Record:",!!
+16 SET O=0
+17 FOR
Begin DoDot:2
+18 SET O=$ORDER(^ABSPF(9002313.92,IEN,NODE,"B",O))
+19 IF '+O
QUIT
+20 SET MIEN=$ORDER(^ABSPF(9002313.92,IEN,NODE,"B",O,""))
+21 IF '+MIEN
QUIT
+22 SET MD=$GET(^ABSPF(9002313.92,IEN,NODE,MIEN,0))
+23 SET FIEN=$PIECE(MD,U,2)
+24 IF '+FIEN
QUIT
+25 SET FD=$GET(^ABSPF(9002313.91,FIEN,0))
+26 IF $PIECE(MD,U,3)="X"
SET XFLAG(NODE,MIEN)=FIEN
+27 WRITE $JUSTIFY(O,3)," ",$JUSTIFY($PIECE(FD,U,1),3)," ",$PIECE(MD,U,3)," ",$PIECE(FD,U,3),!
End DoDot:2
IF '+O
QUIT
End DoDot:1
+28 HANG 1
+29 WRITE @IOF
+30 IF $DATA(XFLAG)
Begin DoDot:1
+31 DO R2HEADER(IEN)
+32 FOR NODE=10,20,30,40
Begin DoDot:2
+33 IF '$DATA(XFLAG(NODE))
QUIT
+34 WRITE !
+35 SET MIEN=""
+36 FOR
Begin DoDot:3
+37 SET MIEN=$ORDER(XFLAG(NODE,MIEN))
+38 IF '+MIEN
QUIT
+39 SET FIEN=$GET(XFLAG(NODE,MIEN))
+40 IF FIEN=""
QUIT
+41 SET RD=$GET(^ABSPF(9002313.91,FIEN,0))
+42 IF RD=""
QUIT
+43 WRITE !,$JUSTIFY($PIECE(RD,U,1),3),?10,$PIECE(RD,U,3),!
+44 SET GN=0
+45 FOR
Begin DoDot:4
+46 SET GN=$ORDER(^ABSPF(9002313.92,IEN,NODE,MIEN,1,GN))
+47 IF '+GN
QUIT
+48 SET GCODE=$GET(^ABSPF(9002313.92,IEN,NODE,MIEN,1,GN,0))
+49 WRITE ?10,"X",GN,": ",GCODE,!
End DoDot:4
IF '+GN
QUIT
End DoDot:3
IF '+MIEN
QUIT
End DoDot:2
+50 HANG 1
+51 WRITE @IOF
End DoDot:1
+52 QUIT
+53 ;----------------------------------------------------------------------
+1 WRITE "NCPDP Record Definition"
+2 WRITE $$RJBF^ABSPECFM($PIECE($GET(^ABSPF(9002313.92,IEN,0)),U,1),IOM-23),!
+3 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","-"),!
+4 QUIT
