ABMDESL1 ; IHS/ASDST/DMJ - Selective Looping Parameters-PART 2 ;
;;2.6;IHS 3P BILLING SYSTEM;**11,21**;NOV 12, 2009;Build 379
;
;IHS/SD/SDR - v2.5 p10 - IM13359 - Added code to select range of patients
;IHS/SD/SDR - 2.6*21 - VMBP - Updated documentation from p11 to contain Serena ref#s
;
LOC ;EP for selecting location
W ! K DIC,ABMY("LOC")
S DIC="^BAR(90052.05,DUZ(2),"
S DIC(0)="AEQM"
S DIC("A")="Select LOCATION: "
D ^DIC K DIC
Q:+Y<1
S ABMY("LOC")=+Y
Q
;
TYP ;EP for selecting Billing Entity
K DIR,ABMY("TYP"),ABMY("INS"),ABMY("PAT")
;S DIR(0)="SO^1:MEDICARE;2:MEDICAID;3:PRIVATE INSURANCE;4:NON-BENEFICIARY PATIENTS;5:BENEFICIARY PATIENTS;6:SPECIFIC INSURER" ;abm*2.6*11 VMBP#8 RQMT_101
S DIR(0)="SO^1:MEDICARE;2:MEDICAID;3:PRIVATE INSURANCE;4:NON-BENEFICIARY PATIENTS;5:BENEFICIARY PATIENTS;6:SPECIFIC INSURER;7:VETERANS MEDICAL BENEFIT PROG" ;abm*2.6*11 VMBP#8 RQMT_101
;I '$D(ABMY("RNG")) S DIR(0)=DIR(0)_";7:SPECIFIC PATIENT" ;abm*2.6*11 VMBP#8 RQM1_101
I '$D(ABMY("RNG")) S DIR(0)=DIR(0)_";8:SPECIFIC PATIENT" ;abm*2.6*11 VMBP#8 RQM1_101
S DIR("A")="Select TYPE of BILLING ENTITY to Display"
D ^DIR K DIR Q:$D(DIRUT)!$D(DIROUT)
;start old code abm*2.6*11 VMBP#8 RQM1_101
;S ABMY("TYP")=$S(Y=1:"R",Y=2:"D",Y=3:"P",Y=4:"N",Y=5:"I",1:Y),ABMY("TYP","NM")=Y(0)
;G INS:Y=6,PAT:Y=7
;end old code start new code VMBP#8 RQM1_101
S ABMY("TYP")=$S(Y=1:"R",Y=2:"D",Y=3:"P",Y=4:"N",Y=5:"I",Y=7:"V",1:Y),ABMY("TYP","NM")=Y(0)
G INS:Y=6,PAT:Y=8
;end new code VMBP#8 RQM1_101
Q
;
INS K ABMY("TYP"),ABMY("INS") W ! S DIC="^AUTNINS(",DIC(0)="QEAM" D ^DIC
Q:+Y<1 S ABMY("INS")=+Y
Q
;
PAT K ABMY("TYP"),ABMY("PAT")
W ! S DIC="^AUPNPAT(",DIC(0)="QEAM" D ^DIC K AUPNLK("ALL")
Q:+Y<1 S ABMY("PAT")=+Y
Q
;
DT ;EP for selecting Visit Date Range
K DIR,ABMY("DT")
S ABMY("DT")="V"
S Y="VISIT DATE"
W !!," ============ Entry of ",Y," Range ============="
W ! S DIR("A")="Enter STARTING "_Y_" for the Looping",DIR(0)="DO^::E" D ^DIR
I $D(DIRUT)!$D(DIROUT) K ABMY("DT"),DIR Q
S ABMY("DT",1)=Y
W ! S DIR("A")="Enter ENDING DATE for the Looping" D ^DIR K DIR
I $D(DIRUT)!$D(DIROUT) K ABMY("DT") Q
S ABMY("DT",2)=Y
I ABMY("DT",1)>ABMY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DT
Q
;
CLN ;EP for selecting CLINIC
K ABMY("CLN"),DIC W ! S DIC="^DIC(40.7,",DIC(0)="QEAM" D ^DIC
S:+Y>0 ABMY("CLN")=+Y
Q
;
VTYP ;EP for selecting Visit Type
K ABMY("VTYP"),DIC W ! S DIC="^ABMDVTYP(",DIC(0)="QEAM" D ^DIC
S:+Y>0 ABMY("VTYP")=+Y
Q
;
PRV ;EP for selecting Provider
K ABMY("PRV"),DIC W ! S DIC="^VA(200,",DIC(0)="QEAM" D ^DIC
S:+Y>0 ABMY("PRV")=+Y
Q
;
ELIG ;EP for selecting Bene Class
K DIR S DIR(0)="SO^1:INDIAN BENEFICIARY PATIENTS;2:NON-BENEFICIARY PATIENTS"
S DIR("A")="Select the PATIENT ELIGIBILITY STATUS"
S DIR("?")="Selection of an Eligibility Status will restrict the report to only those visits in which the patient is of the type designated."
D ^DIR K DIR Q:$D(DIRUT)
S ABMY("PTYP")=Y,ABMY("PTYP","NM")=Y(0)
Q
RANGE ;
K DIR,ABMY("RNG")
STARTR W !!,"Select RANGE OF PATIENTS to display:"
W ! S DIR("A")="Start with Patient Name"
S DIR("?")="Response must be three alpha characters"
S DIR(0)="F^3:3" D ^DIR
I $D(DIRUT)!$D(DIROUT) K ABMY("RNG"),DIR Q
S ABMCK=$$ALPHACK(Y)
I ABMCK=0 W !!?4,"Must be alpha characters only! (NO numbers, punctuation, etc)" K Y G STARTR
S ABMY("RNG",1)=$$UPC^ABMERUTL(Y)
ENDR W !
S DIR(0)="F^3:3"
S DIR("?")="Response must be three alpha characters"
S DIR("B")=$G(ABMY("RNG",1))
S DIR("A")="Go to Patient Name" D ^DIR K DIR
I $D(DIRUT)!$D(DIROUT) K ABMY("RNG") Q
S ABMCK=$$ALPHACK(Y)
I ABMCK=0 W !!?4,"Must be alpha characters only! (NO numbers, punctuaton, etc)" K Y G ENDR
S ABMY("RNG",2)=$$UPC^ABMERUTL(Y)
D SEQCK ;check if start name before go to name
I '$D(ABMY("RNG")) W !!?4,"Invalid range...please try again!" G RANGE
Q
ALPHACK(X) ;
N ABMI,ABMTST,ABMPCE
N ABMCK
S ABMCK=1
S ABMTST=$$UPC^ABMERUTL(X)
S ABMI=""
F ABMI=1:1:$L(ABMTST) D
.S ABMPCE=$E(ABMTST,ABMI)
.I $A(ABMPCE)<65 S ABMCK=0 ;before A
.I $A(ABMPCE)>90 S ABMCK=0 ;after Z
Q ABMCK
SEQCK ;
K ABMPCE
F ABMI=1,2 D
.F ABMJ=1:1:3 D
..S ABMPCE(ABMI)=$G(ABMPCE(ABMI))_$A($E(ABMY("RNG",ABMI),ABMJ))
I ABMPCE(1)>ABMPCE(2) K ABMY("RNG")
Q
ABMDESL1 ; IHS/ASDST/DMJ - Selective Looping Parameters-PART 2 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,21**;NOV 12, 2009;Build 379
+2 ;
+3 ;IHS/SD/SDR - v2.5 p10 - IM13359 - Added code to select range of patients
+4 ;IHS/SD/SDR - 2.6*21 - VMBP - Updated documentation from p11 to contain Serena ref#s
+5 ;
LOC ;EP for selecting location
+1 WRITE !
KILL DIC,ABMY("LOC")
+2 SET DIC="^BAR(90052.05,DUZ(2),"
+3 SET DIC(0)="AEQM"
+4 SET DIC("A")="Select LOCATION: "
+5 DO ^DIC
KILL DIC
+6 IF +Y<1
QUIT
+7 SET ABMY("LOC")=+Y
+8 QUIT
+9 ;
TYP ;EP for selecting Billing Entity
+1 KILL DIR,ABMY("TYP"),ABMY("INS"),ABMY("PAT")
+2 ;S DIR(0)="SO^1:MEDICARE;2:MEDICAID;3:PRIVATE INSURANCE;4:NON-BENEFICIARY PATIENTS;5:BENEFICIARY PATIENTS;6:SPECIFIC INSURER" ;abm*2.6*11 VMBP#8 RQMT_101
+3 ;abm*2.6*11 VMBP#8 RQMT_101
SET DIR(0)="SO^1:MEDICARE;2:MEDICAID;3:PRIVATE INSURANCE;4:NON-BENEFICIARY PATIENTS;5:BENEFICIARY PATIENTS;6:SPECIFIC INSURER;7:VETERANS MEDICAL BENEFIT PROG"
+4 ;I '$D(ABMY("RNG")) S DIR(0)=DIR(0)_";7:SPECIFIC PATIENT" ;abm*2.6*11 VMBP#8 RQM1_101
+5 ;abm*2.6*11 VMBP#8 RQM1_101
IF '$DATA(ABMY("RNG"))
SET DIR(0)=DIR(0)_";8:SPECIFIC PATIENT"
+6 SET DIR("A")="Select TYPE of BILLING ENTITY to Display"
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
QUIT
+8 ;start old code abm*2.6*11 VMBP#8 RQM1_101
+9 ;S ABMY("TYP")=$S(Y=1:"R",Y=2:"D",Y=3:"P",Y=4:"N",Y=5:"I",1:Y),ABMY("TYP","NM")=Y(0)
+10 ;G INS:Y=6,PAT:Y=7
+11 ;end old code start new code VMBP#8 RQM1_101
+12 SET ABMY("TYP")=$SELECT(Y=1:"R",Y=2:"D",Y=3:"P",Y=4:"N",Y=5:"I",Y=7:"V",1:Y)
SET ABMY("TYP","NM")=Y(0)
+13 IF Y=6
GOTO INS
IF Y=8
GOTO PAT
+14 ;end new code VMBP#8 RQM1_101
+15 QUIT
+16 ;
INS KILL ABMY("TYP"),ABMY("INS")
WRITE !
SET DIC="^AUTNINS("
SET DIC(0)="QEAM"
DO ^DIC
+1 IF +Y<1
QUIT
SET ABMY("INS")=+Y
+2 QUIT
+3 ;
PAT KILL ABMY("TYP"),ABMY("PAT")
+1 WRITE !
SET DIC="^AUPNPAT("
SET DIC(0)="QEAM"
DO ^DIC
KILL AUPNLK("ALL")
+2 IF +Y<1
QUIT
SET ABMY("PAT")=+Y
+3 QUIT
+4 ;
DT ;EP for selecting Visit Date Range
+1 KILL DIR,ABMY("DT")
+2 SET ABMY("DT")="V"
+3 SET Y="VISIT DATE"
+4 WRITE !!," ============ Entry of ",Y," Range ============="
+5 WRITE !
SET DIR("A")="Enter STARTING "_Y_" for the Looping"
SET DIR(0)="DO^::E"
DO ^DIR
+6 IF $DATA(DIRUT)!$DATA(DIROUT)
KILL ABMY("DT"),DIR
QUIT
+7 SET ABMY("DT",1)=Y
+8 WRITE !
SET DIR("A")="Enter ENDING DATE for the Looping"
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)!$DATA(DIROUT)
KILL ABMY("DT")
QUIT
+10 SET ABMY("DT",2)=Y
+11 IF ABMY("DT",1)>ABMY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
GOTO DT
+12 QUIT
+13 ;
CLN ;EP for selecting CLINIC
+1 KILL ABMY("CLN"),DIC
WRITE !
SET DIC="^DIC(40.7,"
SET DIC(0)="QEAM"
DO ^DIC
+2 IF +Y>0
SET ABMY("CLN")=+Y
+3 QUIT
+4 ;
VTYP ;EP for selecting Visit Type
+1 KILL ABMY("VTYP"),DIC
WRITE !
SET DIC="^ABMDVTYP("
SET DIC(0)="QEAM"
DO ^DIC
+2 IF +Y>0
SET ABMY("VTYP")=+Y
+3 QUIT
+4 ;
PRV ;EP for selecting Provider
+1 KILL ABMY("PRV"),DIC
WRITE !
SET DIC="^VA(200,"
SET DIC(0)="QEAM"
DO ^DIC
+2 IF +Y>0
SET ABMY("PRV")=+Y
+3 QUIT
+4 ;
ELIG ;EP for selecting Bene Class
+1 KILL DIR
SET DIR(0)="SO^1:INDIAN BENEFICIARY PATIENTS;2:NON-BENEFICIARY PATIENTS"
+2 SET DIR("A")="Select the PATIENT ELIGIBILITY STATUS"
+3 SET DIR("?")="Selection of an Eligibility Status will restrict the report to only those visits in which the patient is of the type designated."
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+5 SET ABMY("PTYP")=Y
SET ABMY("PTYP","NM")=Y(0)
+6 QUIT
RANGE ;
+1 KILL DIR,ABMY("RNG")
STARTR WRITE !!,"Select RANGE OF PATIENTS to display:"
+1 WRITE !
SET DIR("A")="Start with Patient Name"
+2 SET DIR("?")="Response must be three alpha characters"
+3 SET DIR(0)="F^3:3"
DO ^DIR
+4 IF $DATA(DIRUT)!$DATA(DIROUT)
KILL ABMY("RNG"),DIR
QUIT
+5 SET ABMCK=$$ALPHACK(Y)
+6 IF ABMCK=0
WRITE !!?4,"Must be alpha characters only! (NO numbers, punctuation, etc)"
KILL Y
GOTO STARTR
+7 SET ABMY("RNG",1)=$$UPC^ABMERUTL(Y)
ENDR WRITE !
+1 SET DIR(0)="F^3:3"
+2 SET DIR("?")="Response must be three alpha characters"
+3 SET DIR("B")=$GET(ABMY("RNG",1))
+4 SET DIR("A")="Go to Patient Name"
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)!$DATA(DIROUT)
KILL ABMY("RNG")
QUIT
+6 SET ABMCK=$$ALPHACK(Y)
+7 IF ABMCK=0
WRITE !!?4,"Must be alpha characters only! (NO numbers, punctuaton, etc)"
KILL Y
GOTO ENDR
+8 SET ABMY("RNG",2)=$$UPC^ABMERUTL(Y)
+9 ;check if start name before go to name
DO SEQCK
+10 IF '$DATA(ABMY("RNG"))
WRITE !!?4,"Invalid range...please try again!"
GOTO RANGE
+11 QUIT
ALPHACK(X) ;
+1 NEW ABMI,ABMTST,ABMPCE
+2 NEW ABMCK
+3 SET ABMCK=1
+4 SET ABMTST=$$UPC^ABMERUTL(X)
+5 SET ABMI=""
+6 FOR ABMI=1:1:$LENGTH(ABMTST)
Begin DoDot:1
+7 SET ABMPCE=$EXTRACT(ABMTST,ABMI)
+8 ;before A
IF $ASCII(ABMPCE)<65
SET ABMCK=0
+9 ;after Z
IF $ASCII(ABMPCE)>90
SET ABMCK=0
End DoDot:1
+10 QUIT ABMCK
SEQCK ;
+1 KILL ABMPCE
+2 FOR ABMI=1,2
Begin DoDot:1
+3 FOR ABMJ=1:1:3
Begin DoDot:2
+4 SET ABMPCE(ABMI)=$GET(ABMPCE(ABMI))_$ASCII($EXTRACT(ABMY("RNG",ABMI),ABMJ))
End DoDot:2
End DoDot:1
+5 IF ABMPCE(1)>ABMPCE(2)
KILL ABMY("RNG")
+6 QUIT
