- 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
