Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPECR2

ABSPECR2.m

Go to the documentation of this file. 
  1. 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
  1.  ;----------------------------------------------------------------------
  1.  ;----------------------------------------------------------------------
  1.  ;NCPDP Record Print-Out
  1.  ; Why this and not ABSPECR1?  Don't know.
  1.  ; Just carrying it along for now.
  1.  ;----------------------------------------------------------------------
  1. EN1 ;
  1.  ;Open 10:(MODE="W":FILE="A:NCPDP-R.TXT")
  1.  ;Use 10
  1.  ;S NEXTIEN=0
  1.  ;F  D  Q:'+NEXTIEN
  1.  ;.S NEXTIEN=$ORDER(^ABSPF(9002313.92,NEXTIEN))
  1.  ;.Q:'+NEXTIEN
  1.  ;.D R2(NEXTIEN)
  1.  S NEXTIEN=8
  1.  D R2(NEXTIEN)
  1.  ;Close 10
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. EN2(NEXTIEN) ;
  1.  ;Open 10:(MODE="W":FILE="A:NCPDP-R.TXT")
  1.  ;Use 10
  1.  D R2(NEXTIEN)
  1.  ;Close 10
  1.  Q
  1.  ;---------------------------------------------------------------------
  1. R2(IEN) ;EP -
  1.  N FDATA,FIEN,GCODE,GN,MDATA,MIEN,NODE,ORDER,RDATA,XFLAG
  1.  N POSITION,LENGTH,GSPOS S POSITION=1
  1.  N IENS S IENS=IEN_","
  1.  I '$G(IOM) N IOM S IOM=80
  1.  D R2HEADER(IEN)
  1.  F NODE=10,20,30,40 D
  1.  .W !
  1.  .I NODE=10 W "Claim Header (Required) Record:",!!
  1.  .I NODE=20 W "Claim Header (Optional) Record:",!!
  1.  .I NODE=30 D
  1.  . . I '$$GET1^DIQ(9002313.92,IENS,1.07,"I") D
  1.  . . . D GS W !
  1.  . . . S GSPOS=POSITION
  1.  . . W "Claim Information (Required) Record:",!!
  1.  .I NODE=40 W "Claim Information (Optional) Record:",!!
  1.  .S ORDER=0
  1.  .F  D  Q:'+ORDER
  1.  ..S ORDER=$ORDER(^ABSPF(9002313.92,IEN,NODE,"B",ORDER))
  1.  ..Q:'+ORDER
  1.  ..S MIEN=$ORDER(^ABSPF(9002313.92,IEN,NODE,"B",ORDER,""))
  1.  ..Q:'+MIEN
  1.  ..S MDATA=$G(^ABSPF(9002313.92,IEN,NODE,MIEN,0))
  1.  ..I $P(MDATA,U,3)="" S $P(MDATA,U,3)="S" ; defaults to Standard mode
  1.  ..S FIEN=$P(MDATA,U,2)
  1.  ..Q:'+FIEN
  1.  ..S FDATA=$G(^ABSPF(9002313.91,FIEN,0))
  1.  ..S LENGTH=$P(FDATA,U,5)
  1.  ..I NODE=20!(NODE=40) S LENGTH=LENGTH+3
  1.  ..S:$P(MDATA,U,3)="X" XFLAG(NODE,MIEN)=FIEN
  1.  ..W $J(ORDER,3),"  "
  1.  ..W $J($P(FDATA,U,1),3),"  "
  1.  ..W $J(POSITION,3)
  1.  ..I LENGTH>1 D
  1.  ...W "-",$J(POSITION+LENGTH-1,3)
  1.  ..E  D
  1.  ...W " ","   "
  1.  ..W "  "
  1.  ..S POSITION=POSITION+LENGTH
  1.  ..W $P(MDATA,U,3),"  "
  1.  ..W $P(FDATA,U,3),!
  1.  ;W !,"Total length of claim record: ",POSITION-1," bytes",!
  1.  ; more claims in the same packet, maybe
  1.  I $G(GSPOS) N CLAIMLEN S CLAIMLEN=POSITION-GSPOS ; length of one claim
  1.  F N=2:1:$$GET1^DIQ(9002313.92,IENS,1.03) D CLAIM(N)
  1.  ;W #
  1.  D:$D(XFLAG)
  1.  .;D R2HEADER(IEN)
  1.  .F NODE=10,20,30,40 D
  1.  ..Q:'$D(XFLAG(NODE))
  1.  ..W !
  1.  ..S MIEN=""
  1.  ..F  D  Q:'+MIEN
  1.  ...S MIEN=$ORDER(XFLAG(NODE,MIEN))
  1.  ...Q:'+MIEN
  1.  ...S FIEN=$G(XFLAG(NODE,MIEN))
  1.  ...Q:FIEN=""
  1.  ...S RDATA=$G(^ABSPF(9002313.91,FIEN,0))
  1.  ...Q:RDATA=""
  1.  ...W $J($P(RDATA,U,1),3),?10,$P(RDATA,U,3),!
  1.  ...S GN=0
  1.  ...F  D  Q:'+GN
  1.  ....S GN=$ORDER(^ABSPF(9002313.92,IEN,NODE,MIEN,1,GN))
  1.  ....Q:'+GN
  1.  ....S GCODE=$G(^ABSPF(9002313.92,IEN,NODE,MIEN,1,GN,0))
  1.  ....W ?10,"X",GN,":  ",GCODE,!
  1.  .W #
  1.  Q
  1. GS ; where a group separator occurs
  1.  W "          ",$J(POSITION,3),"         "
  1.  W "Group Separator ($C(29))",!
  1.  S POSITION=POSITION+1
  1.  Q
  1. CLAIM(N) ; where 2nd, 3rd, 4th claims go
  1.  W !
  1.  D GS ; a group separator comes first
  1.  W "          ",$J(POSITION,3)
  1.  W "-",$J(POSITION+CLAIMLEN-1,3),"     "
  1.  W "Claim #",N,!
  1.  S POSITION=POSITION+CLAIMLEN
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. R2HEADER(IEN) ;
  1.  W $$GET1^DIQ(9002313.92,IENS,.01)
  1.  W " (`",IEN,")",!
  1.  W $TR($J("",IOM)," ","-"),!
  1.  I '$$GET1^DIQ(9002313.92,IENS,1.07,"I") D  ; if not a reversal format
  1.  . N FIELD S FIELD=1
  1.  . F  S FIELD=$O(^DD(9002313.92,FIELD)) Q:'FIELD  D
  1.  . . I FIELD'<10,FIELD'>40 Q
  1.  . . I FIELD=1.07 Q  ; "Is A Reversal Format"
  1.  . . W $$GET1^DID(9002313.92,FIELD,,"LABEL"),": "
  1.  . . W $$GET1^DIQ(9002313.92,IENS,FIELD)
  1.  . . W !
  1.  Q