- ABMMRS ; IHS/ASDST/DMJ - NEW PROGRAM ;
- ;;2.4;IHS 3P BILLING SYSTEM;;APR 14, 2000
- ;IHS/DSD/MRS
- INIT S SITE=0,BDFN="",U="^"
- K ^ABMMRS
- F S SITE=$O(^ABMDBILL(SITE)) Q:'SITE D
- .S BDFN=0 F S BDFN=$O(^ABMDBILL(SITE,BDFN)) Q:'BDFN D
- ..I '$D(^ABMDBILL(SITE,BDFN,0)) Q
- ..S STR1=^ABMDBILL(SITE,BDFN,0)
- ..S BSTAT=$P(STR1,U,4),PDFN=$P(STR1,U,5),BTYP=$P(STR1,U,2)
- ..S PAT=PDFN I PDFN="" S PDFN="NULL"
- ..D GETPAT
- ..S BILL=$P(STR1,U,1),CLAIM=+BILL,IIEN=$P(STR1,U,8)
- ..D GETINS
- ..D SET
- ..D CKCL
- S N=0,X="" F S X=$O(^ABMMRS(X)) Q:X="" S N=N+1
- S ^ABMMRS=N
- D KILL
- Q
- SET ;
- S STR2=BILL_U_BTYP_U_VLOC_U_STAT_U_PAT_U_MODE_U_VTYP_U_IIEN_U_CODE
- S STR=STR1_"***"_STR2_U_CLINIC_U_VIEN
- S ^ABMMRS(CLAIM,BDFN,"BILL",PDFN,SITE)=STR
- I PDFN="NULL" S ^ABMMRS(CLAIM,"NULL")=STR
- S ^ABMMRS(CLAIM)=$G(^ABMMRS(CLAIM))+1
- Q
- GETPAT ; Get info from visit file
- S (CLINIC,STAT,VLOC)=""
- S VIEN=$P($G(^ABMDBILL(SITE,BDFN,11,0)),U,3)
- I VIEN'="" D
- .S TMP=$G(^AUPNVSIT(VIEN,0))
- .S PAT=$P(TMP,U,5),CLINIC=$P(TMP,U,8),STAT=$P(TMP,U,4),VLOC=$P(TMP,U,6)
- I STAT="" S STAT=BSTAT
- I VLOC="" S VLOC=SITE
- I PAT="" S PAT="NULL"
- Q
- GETINS ; Get more info from insurance file
- S (VTYP,CODE,MODE)=""
- I $D(^ABMDBILL(SITE,BDFN,13,"C",1)) S INX="" D
- .S INX=$O(^ABMDBILL(SITE,BDFN,13,"C",1,""))
- .I INX="" Q
- .S IIEN=$P(^ABMDBILL(SITE,BDFN,13,INX,0),U,1)
- Q:IIEN=""!(BTYP="")
- S TMP=$G(^ABMNINS(SITE,IIEN,1,BTYP,0))
- S VTYP=$P(TMP,U,1),CODE=$P(TMP,U,2),MODE=$P(TMP,U,4)
- Q
- CKCL S CSITE=0
- F S CSITE=$O(^ABMDCLM(CSITE)) Q:'CSITE D
- .I '$D(^ABMDCLM(CSITE,CLAIM,0)) Q
- .S CSTR=^ABMDCLM(CSITE,CLAIM,0),CPDFN=$P(CSTR,U,1)
- .I CPDFN="" S CPDFN="NULL"
- .I CPDFN="NULL" S ^ABMMRS(CLAIM,BDFN,"NULL",CPDFN,CSITE)=CSTR
- .S ^ABMMRS(CLAIM,BDFN,"CLAIM",CPDFN,CSITE)=CSTR
- .S ^ABMMRS(CLAIM)=^ABMMRS(CLAIM)+1
- Q
- KILL S CLAIM=""
- F S CLAIM=$O(^ABMMRS(CLAIM)) Q:CLAIM="" D
- .I '$D(^ABMMRS(CLAIM,"NULL")) K ^ABMMRS(CLAIM) Q
- .K ^ABMMRS(CLAIM,"NULL")
- S N=0,X="" F S X=$O(^ABMMRS(X)) Q:X="" S N=N+1
- S ^ABMMRS=^ABMMRS_"^"_N
- Q
- ABMMRS ; IHS/ASDST/DMJ - NEW PROGRAM ;
- +1 ;;2.4;IHS 3P BILLING SYSTEM;;APR 14, 2000
- +2 ;IHS/DSD/MRS
- INIT SET SITE=0
- SET BDFN=""
- SET U="^"
- +1 KILL ^ABMMRS
- +2 FOR
- SET SITE=$ORDER(^ABMDBILL(SITE))
- IF 'SITE
- QUIT
- Begin DoDot:1
- +3 SET BDFN=0
- FOR
- SET BDFN=$ORDER(^ABMDBILL(SITE,BDFN))
- IF 'BDFN
- QUIT
- Begin DoDot:2
- +4 IF '$DATA(^ABMDBILL(SITE,BDFN,0))
- QUIT
- +5 SET STR1=^ABMDBILL(SITE,BDFN,0)
- +6 SET BSTAT=$PIECE(STR1,U,4)
- SET PDFN=$PIECE(STR1,U,5)
- SET BTYP=$PIECE(STR1,U,2)
- +7 SET PAT=PDFN
- IF PDFN=""
- SET PDFN="NULL"
- +8 DO GETPAT
- +9 SET BILL=$PIECE(STR1,U,1)
- SET CLAIM=+BILL
- SET IIEN=$PIECE(STR1,U,8)
- +10 DO GETINS
- +11 DO SET
- +12 DO CKCL
- End DoDot:2
- End DoDot:1
- +13 SET N=0
- SET X=""
- FOR
- SET X=$ORDER(^ABMMRS(X))
- IF X=""
- QUIT
- SET N=N+1
- +14 SET ^ABMMRS=N
- +15 DO KILL
- +16 QUIT
- SET ;
- +1 SET STR2=BILL_U_BTYP_U_VLOC_U_STAT_U_PAT_U_MODE_U_VTYP_U_IIEN_U_CODE
- +2 SET STR=STR1_"***"_STR2_U_CLINIC_U_VIEN
- +3 SET ^ABMMRS(CLAIM,BDFN,"BILL",PDFN,SITE)=STR
- +4 IF PDFN="NULL"
- SET ^ABMMRS(CLAIM,"NULL")=STR
- +5 SET ^ABMMRS(CLAIM)=$GET(^ABMMRS(CLAIM))+1
- +6 QUIT
- GETPAT ; Get info from visit file
- +1 SET (CLINIC,STAT,VLOC)=""
- +2 SET VIEN=$PIECE($GET(^ABMDBILL(SITE,BDFN,11,0)),U,3)
- +3 IF VIEN'=""
- Begin DoDot:1
- +4 SET TMP=$GET(^AUPNVSIT(VIEN,0))
- +5 SET PAT=$PIECE(TMP,U,5)
- SET CLINIC=$PIECE(TMP,U,8)
- SET STAT=$PIECE(TMP,U,4)
- SET VLOC=$PIECE(TMP,U,6)
- End DoDot:1
- +6 IF STAT=""
- SET STAT=BSTAT
- +7 IF VLOC=""
- SET VLOC=SITE
- +8 IF PAT=""
- SET PAT="NULL"
- +9 QUIT
- GETINS ; Get more info from insurance file
- +1 SET (VTYP,CODE,MODE)=""
- +2 IF $DATA(^ABMDBILL(SITE,BDFN,13,"C",1))
- SET INX=""
- Begin DoDot:1
- +3 SET INX=$ORDER(^ABMDBILL(SITE,BDFN,13,"C",1,""))
- +4 IF INX=""
- QUIT
- +5 SET IIEN=$PIECE(^ABMDBILL(SITE,BDFN,13,INX,0),U,1)
- End DoDot:1
- +6 IF IIEN=""!(BTYP="")
- QUIT
- +7 SET TMP=$GET(^ABMNINS(SITE,IIEN,1,BTYP,0))
- +8 SET VTYP=$PIECE(TMP,U,1)
- SET CODE=$PIECE(TMP,U,2)
- SET MODE=$PIECE(TMP,U,4)
- +9 QUIT
- CKCL SET CSITE=0
- +1 FOR
- SET CSITE=$ORDER(^ABMDCLM(CSITE))
- IF 'CSITE
- QUIT
- Begin DoDot:1
- +2 IF '$DATA(^ABMDCLM(CSITE,CLAIM,0))
- QUIT
- +3 SET CSTR=^ABMDCLM(CSITE,CLAIM,0)
- SET CPDFN=$PIECE(CSTR,U,1)
- +4 IF CPDFN=""
- SET CPDFN="NULL"
- +5 IF CPDFN="NULL"
- SET ^ABMMRS(CLAIM,BDFN,"NULL",CPDFN,CSITE)=CSTR
- +6 SET ^ABMMRS(CLAIM,BDFN,"CLAIM",CPDFN,CSITE)=CSTR
- +7 SET ^ABMMRS(CLAIM)=^ABMMRS(CLAIM)+1
- End DoDot:1
- +8 QUIT
- KILL SET CLAIM=""
- +1 FOR
- SET CLAIM=$ORDER(^ABMMRS(CLAIM))
- IF CLAIM=""
- QUIT
- Begin DoDot:1
- +2 IF '$DATA(^ABMMRS(CLAIM,"NULL"))
- KILL ^ABMMRS(CLAIM)
- QUIT
- +3 KILL ^ABMMRS(CLAIM,"NULL")
- End DoDot:1
- +4 SET N=0
- SET X=""
- FOR
- SET X=$ORDER(^ABMMRS(X))
- IF X=""
- QUIT
- SET N=N+1
- +5 SET ^ABMMRS=^ABMMRS_"^"_N
- +6 QUIT
