- ABMDRCO1 ; IHS/ASDST/DMJ - PRINT CO VIST REPORT (CALC) ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Original;TMD;
- ;
- INIT ;EP - initialize variables
- S ABMD("CO")=$O(^AUTTBEN("C","03",0)),ABMD("DEP")=$O(^AUTTBEN("C","04",0))
- S ABMD("RET")=$O(^AUTTBEN("C","30",0)),ABMD("RTD")=$O(^AUTTBEN("C","31",0))
- I ABMD("CO")="" W !!,"CODE 03 NOT IN BENEFICIARY FILE"
- I ABMD("DEP")="" W !!,"CODE 04 NOT IN BENEFICIARY FILE"
- I ABMD("RET")="" W !!,"CODE 30 NOT IN BENEFICIARY FILE"
- I ABMD("RTD")="" W !!,"CODE 31 NOT IN BENEFICIARY FILE"
- S ABMD("DEN")=$O(^DIC(40.7,"C",56,0)) ;dental clinic stop code
- S ABMD("RBDT")=(9999999-ABMD("BDT"))_.2400
- Q
- ;
- MAIN ;
- I ABMD("CO")]"" S ABMD("II")=ABMD("CO") D CALC
- I ABMD("DEP")]"" S ABMD("II")=ABMD("DEP") D CALC
- I ABMD("RET")]"" S ABMD("II")=ABMD("RET") D CALC
- I ABMD("RTD")]"" S ABMD("II")=ABMD("RTD") D CALC
- Q
- ;
- CALC ;find patients and their visits
- S ABMD("DFN")=0
- PAT ;must have hrcn at your facility
- S ABMD("DFN")=$O(^AUPNPAT("AD",ABMD("II"),ABMD("DFN"))) Q:ABMD("DFN")=""
- G PAT:'$D(^AUPNPAT(ABMD("DFN"),41,DUZ(2))) S ABMD("HRCN")=$P(^(DUZ(2),0),"^",2)
- G PAT:'$D(^DPT(ABMD("DFN"),0)) S ABMD("NAME")=$P(^(0),"^")
- ;
- S ABMD("REDT")=9999999-ABMD("EDT")-.0001
- VST S ABMD("REDT")=$O(^AUPNVSIT("AA",ABMD("DFN"),ABMD("REDT"))) G PAT:ABMD("REDT")="",PAT:ABMD("REDT")>ABMD("RBDT") S ABMD("VDFN")=0
- VST1 S ABMD("VDFN")=$O(^AUPNVSIT("AA",ABMD("DFN"),ABMD("REDT"),ABMD("VDFN"))) G VST:ABMD("VDFN")=""
- G VST1:'$D(^AUPNVSIT(ABMD("VDFN"),0)) S ABMD("STR")=^(0)
- G VST1:$P(ABMD("STR"),"^",11)'="" ;screen out deleted visits
- G VST1:$P(ABMD("STR"),"^",6)'=DUZ(2) ;screen out visits at other facilities
- ;
- S ABMD("VDT")=$P(ABMD("STR"),"^"),X=$P(ABMD("STR"),"^",7)
- I (X'="A")&(X'="H")&(X'="S") G VST1
- ;set dental visits
- I $P(ABMD("STR"),"^",8)=ABMD("DEN"),$D(ABMD("TDEN")) S ^TMP("ABMDRCO",ABMD("$J"),"D",ABMD("II"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"),ABMD("VDFN"))=ABMD("HRCN") G VST1
- ;set outpt node
- I X'="H",$D(ABMD("TOP")) S ^TMP("ABMDRCO",ABMD("$J"),"O",ABMD("II"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"),ABMD("VDFN"))=ABMD("HRCN") G VST1
- ;set inpt node
- G VST1:'$D(ABMD("TIP")) S ABMD("IDFN")=$O(^AUPNVINP("AD",ABMD("VDFN"),0)) G VST1:ABMD("IDFN")=""
- S ABMD("DSCH")=+^AUPNVINP(ABMD("IDFN"),0)
- S ^TMP("ABMDRCO",ABMD("$J"),"I",ABMD("II"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"),ABMD("VDFN"))=ABMD("HRCN")_"^"_ABMD("DSCH") G VST1
- Q
- ABMDRCO1 ; IHS/ASDST/DMJ - PRINT CO VIST REPORT (CALC) ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;Original;TMD;
- +3 ;
- INIT ;EP - initialize variables
- +1 SET ABMD("CO")=$ORDER(^AUTTBEN("C","03",0))
- SET ABMD("DEP")=$ORDER(^AUTTBEN("C","04",0))
- +2 SET ABMD("RET")=$ORDER(^AUTTBEN("C","30",0))
- SET ABMD("RTD")=$ORDER(^AUTTBEN("C","31",0))
- +3 IF ABMD("CO")=""
- WRITE !!,"CODE 03 NOT IN BENEFICIARY FILE"
- +4 IF ABMD("DEP")=""
- WRITE !!,"CODE 04 NOT IN BENEFICIARY FILE"
- +5 IF ABMD("RET")=""
- WRITE !!,"CODE 30 NOT IN BENEFICIARY FILE"
- +6 IF ABMD("RTD")=""
- WRITE !!,"CODE 31 NOT IN BENEFICIARY FILE"
- +7 ;dental clinic stop code
- SET ABMD("DEN")=$ORDER(^DIC(40.7,"C",56,0))
- +8 SET ABMD("RBDT")=(9999999-ABMD("BDT"))_.2400
- +9 QUIT
- +10 ;
- MAIN ;
- +1 IF ABMD("CO")]""
- SET ABMD("II")=ABMD("CO")
- DO CALC
- +2 IF ABMD("DEP")]""
- SET ABMD("II")=ABMD("DEP")
- DO CALC
- +3 IF ABMD("RET")]""
- SET ABMD("II")=ABMD("RET")
- DO CALC
- +4 IF ABMD("RTD")]""
- SET ABMD("II")=ABMD("RTD")
- DO CALC
- +5 QUIT
- +6 ;
- CALC ;find patients and their visits
- +1 SET ABMD("DFN")=0
- PAT ;must have hrcn at your facility
- +1 SET ABMD("DFN")=$ORDER(^AUPNPAT("AD",ABMD("II"),ABMD("DFN")))
- IF ABMD("DFN")=""
- QUIT
- +2 IF '$DATA(^AUPNPAT(ABMD("DFN"),41,DUZ(2)))
- GOTO PAT
- SET ABMD("HRCN")=$PIECE(^(DUZ(2),0),"^",2)
- +3 IF '$DATA(^DPT(ABMD("DFN"),0))
- GOTO PAT
- SET ABMD("NAME")=$PIECE(^(0),"^")
- +4 ;
- +5 SET ABMD("REDT")=9999999-ABMD("EDT")-.0001
- VST SET ABMD("REDT")=$ORDER(^AUPNVSIT("AA",ABMD("DFN"),ABMD("REDT")))
- IF ABMD("REDT")=""
- GOTO PAT
- IF ABMD("REDT")>ABMD("RBDT")
- GOTO PAT
- SET ABMD("VDFN")=0
- VST1 SET ABMD("VDFN")=$ORDER(^AUPNVSIT("AA",ABMD("DFN"),ABMD("REDT"),ABMD("VDFN")))
- IF ABMD("VDFN")=""
- GOTO VST
- +1 IF '$DATA(^AUPNVSIT(ABMD("VDFN"),0))
- GOTO VST1
- SET ABMD("STR")=^(0)
- +2 ;screen out deleted visits
- IF $PIECE(ABMD("STR"),"^",11)'=""
- GOTO VST1
- +3 ;screen out visits at other facilities
- IF $PIECE(ABMD("STR"),"^",6)'=DUZ(2)
- GOTO VST1
- +4 ;
- +5 SET ABMD("VDT")=$PIECE(ABMD("STR"),"^")
- SET X=$PIECE(ABMD("STR"),"^",7)
- +6 IF (X'="A")&(X'="H")&(X'="S")
- GOTO VST1
- +7 ;set dental visits
- +8 IF $PIECE(ABMD("STR"),"^",8)=ABMD("DEN")
- IF $DATA(ABMD("TDEN"))
- SET ^TMP("ABMDRCO",ABMD("$J"),"D",ABMD("II"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"),ABMD("VDFN"))=ABMD("HRCN")
- GOTO VST1
- +9 ;set outpt node
- +10 IF X'="H"
- IF $DATA(ABMD("TOP"))
- SET ^TMP("ABMDRCO",ABMD("$J"),"O",ABMD("II"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"),ABMD("VDFN"))=ABMD("HRCN")
- GOTO VST1
- +11 ;set inpt node
- +12 IF '$DATA(ABMD("TIP"))
- GOTO VST1
- SET ABMD("IDFN")=$ORDER(^AUPNVINP("AD",ABMD("VDFN"),0))
- IF ABMD("IDFN")=""
- GOTO VST1
- +13 SET ABMD("DSCH")=+^AUPNVINP(ABMD("IDFN"),0)
- +14 SET ^TMP("ABMDRCO",ABMD("$J"),"I",ABMD("II"),ABMD("NAME"),ABMD("DFN"),ABMD("VDT"),ABMD("VDFN"))=ABMD("HRCN")_"^"_ABMD("DSCH")
- GOTO VST1
- +15 QUIT
