ABSPES00 ; IHS/FCS/DRS - JWS 03:02 PM 12 Jun 1995 ; [ 09/12/2002 10:03 AM ]
;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
;----------------------------------------------------------------------
;----------------------------------------------------------------------
;Claims Submission File (9002313.02) - Billing Item Search
;
;Parameters: ROOT -
; MAX -
; GROOT - Global root of resulting list (eg: "^LIST($J")
;
;Returns: Fmatted list
;----------------------------------------------------------------------
Q
EN1(ROOT,MAX,GROOT) ;EP - from ABSPECZ2
;
;Search 'Patient Name' cross-reference
D BITEM1(ROOT,"C",MAX,GROOT)
Q:$G(@(GROOT_",0)"))>0
;
;Search 'Billing Item PCN #' cross-reference
D BITEM1(ROOT,"D",MAX,GROOT)
Q:$G(@(GROOT_",0)"))>0
;
;Search 'Billing Item VCN #' cross-reference
D BITEM1(ROOT,"E",MAX,GROOT)
Q
;----------------------------------------------------------------------
;Build list of Billing Item records
BITEM1(ROOT,XREF,MAX,GROOT) ;
N ROOTL,NEXT,DA,COUNT,PCN,VCN,PAT,BAL,DATA,BITEMIEN,NCLAIMS
;
Q:$G(ROOT)=""
Q:$G(XREF)=""
Q:$G(MAX)=""
Q:$G(GROOT)=""
S ROOTL=$L(ROOT)
Q:ROOTL<2
;
K @(GROOT_")")
S COUNT=0
S NEXT=$S(XREF="E"&'($E(ROOT,$L(ROOT))?1A):ROOT_" ",1:ROOT)
S:$DATA(^ABSPC(XREF,NEXT)) NEXT=$O(^ABSPC(XREF,NEXT),-1)
F D Q:$E(NEXT,1,ROOTL)'=ROOT!(COUNT=MAX)
.S NEXT=$O(^ABSPC(XREF,NEXT))
.Q:$E(NEXT,1,ROOTL)'=ROOT
.S DA=""
.F D Q:'+DA
..S DA=$O(^ABSPC(XREF,NEXT,DA))
..Q:'+DA
..Q:'$DATA(^ABSPC(DA,0))
..S BITEMIEN=$P($G(^ABSPC(DA,0)),U,3)
..Q:'+BITEMIEN
..Q:$DATA(@(GROOT_",""B"",BITEMIEN)"))
..S @(GROOT_",""B"",BITEMIEN)")=""
..S COUNT=COUNT+1
..S @(GROOT_",COUNT,""I"")")=BITEMIEN
..S DATA=$G(^ABSPC(DA,1))
..S PAT=$$LJBF^ABSPOSU9($P(DATA,U,1),30)
..S PCN=$$LJBF^ABSPOSU9($P(DATA,U,2),12)
..S VCN=$$LJBF^ABSPOSU9($P(DATA,U,3),10)
..S NCLAIMS=$$RJBF^ABSPOSU9($$NCLAIMS(BITEMIEN),7)
..S @(GROOT_",COUNT,""E"")")=PAT_" "_PCN_" "_VCN_" "_NCLAIMS
S @(GROOT_",""Column Headers"")")="2|Patient Name:30,PCN #:12,VCN #:10,# Claims:7"
S @(GROOT_",0)")=COUNT
Q
;---------------------------------------------------------------------
;Returns the number of electronic claims for a billing item record
NCLAIMS(BITEMIEN) ;
N COUNT,NEXT
Q:BITEMIEN="" 0
S (NEXT,COUNT)=0
F D Q:'+NEXT
.S NEXT=$O(^ABSPC("AC",BITEMIEN,NEXT))
.Q:'+NEXT
.S COUNT=COUNT+1
Q COUNT
ABSPES00 ; IHS/FCS/DRS - JWS 03:02 PM 12 Jun 1995 ; [ 09/12/2002 10:03 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**3**;JUN 21, 2001;Build 38
+2 ;----------------------------------------------------------------------
+3 ;----------------------------------------------------------------------
+4 ;Claims Submission File (9002313.02) - Billing Item Search
+5 ;
+6 ;Parameters: ROOT -
+7 ; MAX -
+8 ; GROOT - Global root of resulting list (eg: "^LIST($J")
+9 ;
+10 ;Returns: Fmatted list
+11 ;----------------------------------------------------------------------
+12 QUIT
EN1(ROOT,MAX,GROOT) ;EP - from ABSPECZ2
+1 ;
+2 ;Search 'Patient Name' cross-reference
+3 DO BITEM1(ROOT,"C",MAX,GROOT)
+4 IF $GET(@(GROOT_",0)"))>0
QUIT
+5 ;
+6 ;Search 'Billing Item PCN #' cross-reference
+7 DO BITEM1(ROOT,"D",MAX,GROOT)
+8 IF $GET(@(GROOT_",0)"))>0
QUIT
+9 ;
+10 ;Search 'Billing Item VCN #' cross-reference
+11 DO BITEM1(ROOT,"E",MAX,GROOT)
+12 QUIT
+13 ;----------------------------------------------------------------------
+14 ;Build list of Billing Item records
BITEM1(ROOT,XREF,MAX,GROOT) ;
+1 NEW ROOTL,NEXT,DA,COUNT,PCN,VCN,PAT,BAL,DATA,BITEMIEN,NCLAIMS
+2 ;
+3 IF $GET(ROOT)=""
QUIT
+4 IF $GET(XREF)=""
QUIT
+5 IF $GET(MAX)=""
QUIT
+6 IF $GET(GROOT)=""
QUIT
+7 SET ROOTL=$LENGTH(ROOT)
+8 IF ROOTL<2
QUIT
+9 ;
+10 KILL @(GROOT_")")
+11 SET COUNT=0
+12 SET NEXT=$SELECT(XREF="E"&'($EXTRACT(ROOT,$LENGTH(ROOT))?1A):ROOT_" ",1:ROOT)
+13 IF $DATA(^ABSPC(XREF,NEXT))
SET NEXT=$ORDER(^ABSPC(XREF,NEXT),-1)
+14 FOR
Begin DoDot:1
+15 SET NEXT=$ORDER(^ABSPC(XREF,NEXT))
+16 IF $EXTRACT(NEXT,1,ROOTL)'=ROOT
QUIT
+17 SET DA=""
+18 FOR
Begin DoDot:2
+19 SET DA=$ORDER(^ABSPC(XREF,NEXT,DA))
+20 IF '+DA
QUIT
+21 IF '$DATA(^ABSPC(DA,0))
QUIT
+22 SET BITEMIEN=$PIECE($GET(^ABSPC(DA,0)),U,3)
+23 IF '+BITEMIEN
QUIT
+24 IF $DATA(@(GROOT_",""B"",BITEMIEN)"))
QUIT
+25 SET @(GROOT_",""B"",BITEMIEN)")=""
+26 SET COUNT=COUNT+1
+27 SET @(GROOT_",COUNT,""I"")")=BITEMIEN
+28 SET DATA=$GET(^ABSPC(DA,1))
+29 SET PAT=$$LJBF^ABSPOSU9($PIECE(DATA,U,1),30)
+30 SET PCN=$$LJBF^ABSPOSU9($PIECE(DATA,U,2),12)
+31 SET VCN=$$LJBF^ABSPOSU9($PIECE(DATA,U,3),10)
+32 SET NCLAIMS=$$RJBF^ABSPOSU9($$NCLAIMS(BITEMIEN),7)
+33 SET @(GROOT_",COUNT,""E"")")=PAT_" "_PCN_" "_VCN_" "_NCLAIMS
End DoDot:2
IF '+DA
QUIT
End DoDot:1
IF $EXTRACT(NEXT,1,ROOTL)'=ROOT!(COUNT=MAX)
QUIT
+34 SET @(GROOT_",""Column Headers"")")="2|Patient Name:30,PCN #:12,VCN #:10,# Claims:7"
+35 SET @(GROOT_",0)")=COUNT
+36 QUIT
+37 ;---------------------------------------------------------------------
+38 ;Returns the number of electronic claims for a billing item record
NCLAIMS(BITEMIEN) ;
+1 NEW COUNT,NEXT
+2 IF BITEMIEN=""
QUIT 0
+3 SET (NEXT,COUNT)=0
+4 FOR
Begin DoDot:1
+5 SET NEXT=$ORDER(^ABSPC("AC",BITEMIEN,NEXT))
+6 IF '+NEXT
QUIT
+7 SET COUNT=COUNT+1
End DoDot:1
IF '+NEXT
QUIT
+8 QUIT COUNT
