BMCVDV1 ; IHS/OIT/FCJ - SELECT CONTRACT NUMBER ; [ 10/15/2004 3:02 PM ]
;;4.0;REFERRED CARE INFO SYSTEM;**5**;JAN 09, 2006;Build 101
;BMC*4.0*5 5.13.2009 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDV1
;
A4 ;EP
G A6:'$D(^AUTTVNDR(BMCPROV,"CN"))
K BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
;
S Y=$$DIR^XBDIR("Y","Want to see Vendor Contract Information","NO","","","",2)
G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT),A6:'Y
S BMCACO="L",P=BMCPROV,A("DISPLAY")=1,BMCCTFL=""
D L^BMCVDV1
A6 ;
G:BMCRT("RQ")<0 A7
S Y=$$DIR^XBDIR("Y","Want to see Vendor Rate Quotation Information","NO","","","",2)
G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT),A7:'Y
S BMCAGTP="RQ",BMCRQFL=""
D AGRDSP^BMCVDV2
A7 ;
G:'$D(BMCRT("PA")) A8
S Y=$$DIR^XBDIR("Y","Want to see Vendor Agreement Information","NO","","","",2)
G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT),A8:'Y
S BMCAGTP="PA",BMCPAFL=""
D AGRDSP^BMCVDV2
A8 ;
G:'$D(BMCRT("BPA")) A9
S Y=$$DIR^XBDIR("Y","Want to see Vendor BPA Information","NO","","","",2)
G END^BMCVDV:$D(DTOUT),A1^BMCVDV:$D(DUOUT),A9:'Y
S BMCAGTP="BPA",BMCBPFL=""
D AGRDSP^BMCVDV2
A9 ;
I '$D(^XUSEC("BMCZVEN",DUZ)) G END^BMCVDV:'$$DIR^XBDIR("E")
G A1^BMCVDV
;
L ;EP
S E=9999999-DT,(S,C,L)=""
I '$D(BMCACO) S BMCACO=""
L1 ;
S S=$O(^AUTTVNDR(BMCPROV,"E",S))
G L3:S=""
S N=""
L2 ;
S N=$O(^AUTTVNDR(BMCPROV,"E",S,N))
G L1:N="",L2:'$D(^AUTTVNDR(BMCPROV,"CN",N,0))
S I=$P(^AUTTVNDR(BMCPROV,"CN",N,0),U),C=C+1,L=N_U_S_U_I I BMCACO["L" D SBT:C=1 W !,$J(C,2),?3,$J($P(^(0),U),18) S D=$P(^(0),U,2,3) D SBD S C(C)=N
I BMCACO["F",C=F G L3
I $Y>24 K DIR S DIR(0)="E" D ^DIR Q:Y=0 K DIR D SBT
G L2
;
L3 ;
G END:'$D(^XUSEC("BMCZVEN",DUZ)),NEW:'$D(^AUTTVNDR(BMCPROV,"CN")),NEW:$P(^AUTTVNDR(BMCPROV,"CN",0),U,4)<1!(A("DISPLAY"))!(+C<1)
W !!,"Which one: "
D READ^BMC
G END:$D(DUOUT)
I Y?1"?".E W !!?3,"Enter 1 thru ",C G L3
I Y="" G NEW
I Y'?1N.N!(Y>C) W !!,"Enter 1 thru ",C G L3
S DA=C(Y)
END ;
K C,N,S,BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
Q
;
SBD ;
W ?22,$$FMTE^XLFDT($P(D,U)),?35,$$FMTE^XLFDT($P(D,U,2)),?49,$E($P(^AUTTVNDR(BMCPROV,"CN",N,0),U,5),1,30)
Q
;
SBT ;EP
W @IOF,!!?5,"Contract Number",?22,"Begin Date",?35,"Ending Date",?49,"Description of Service",!?5,"---------------",?22,"------------",?35,"------------",?49,"-------------------------"
Q
;
NEW ;
W:+C<1 !!,"No Contracts on file."
I $D(BMCCTFL) S DA="" G END
W !!,"Want to Enter a New Contract? NO// "
D READ^BMC
G END:$D(DUOUT)
S Y=$E(Y_"N"),Y=$$UP^XLFSTR(Y)
I Y?1"?".E D YN^BMC G NEW
I Y=""!(Y?1"N".E) S DA="" G END
I Y'?1"Y".E D YN^BMC G NEW
NEW1 ;
W !!,"Enter CONTRACT NUMBER: "
D READ^BMC
G NEW:$D(DUOUT)
I Y?1"?".E W !!,"Enter New Contract Number " G NEW1
G NEW:Y=""
S:'$D(^AUTTVNDR(BMCPROV,"CN",0)) ^(0)="^9999999.1112^"
S DA(1)=BMCPROV,X=Y,DIC="^AUTTVNDR("_BMCPROV_",""CN"",",DIC(0)="ELMQZ"
D ^DIC
G NEW:Y=-1
S DA=+Y
W !
S DIE("NO^")="",DIE="^AUTTVNDR("_BMCPROV_",""CN"",",DA(1)=BMCPROV,DR="1;2;4;3"
D ^DIE
K DIE,DA
G END
;
MP ;EP
W @IOF D MPDSP
S (BMCMP,CT)=0
F I=1:1 S BMCMP=$O(^AUTTVNDR(BMCPROV,"MP",BMCMP)) Q:BMCMP'>0 D
.S BMCDSP(I)=^AUTTVNDR(BMCPROV,"MP",BMCMP,0)
.I BMCDSP(I)'="" S CT=CT+1 S BMCMPN=$P(BMCDSP(I),U),BMCBDT=$P(BMCDSP(I),U,3),BMCEDT=$P(BMCDSP(I),U,4),BMCDES=$P(BMCDSP(I),U,2)
.I $D(BMCDES) S BMCDES=$$EXTSET^XBFUNC(9999999.112303,2,BMCDES)
.W ?2,CT,?6,$G(BMCMPN),?23,$$FMTE^XLFDT($G(BMCBDT)),?37,$$FMTE^XLFDT($G(BMCEDT)),?51,$G(BMCDES),!
W:CT=0 !!,?6,"No Medicare Numbers listed.",! G ASK1
I CT>0 G ASK1
Q
;
MPDSP ;DISPLAY MEDICARE PROVIDER INFO
W !!,"Item",?6,"Medicare Number",?23,"Begin Date",?37,"End Date",?51,"Description",!,"----",?6,"---------------",?23,"------------",?37,"------------",?51,"-------------------------",!
Q
;
ASK1 ;
S Y=$$DIR^XBDIR("Y","Want to add Medicare Information","NO","","","",2)
G END:$D(DUOUT),ASK2:'Y
I Y G MPADD
ASK2 ;
S Y=$$DIR^XBDIR("Y","Want to edit Medicare Information","NO","","","",2)
G END:$D(DUOUT),END:'Y
I Y G MPEDIT
MPADD ;
W !!,"Enter the Medicare NUMBER: "
D READ^BMC
G END:$D(DUOUT)
I Y?1"?".E W !!,"Enter New Number " G MPADD
S:'$D(^AUTTVNDR(BMCPROV,"MP",0)) ^(0)="^9999999.112303^"
S DA(1)=BMCPROV,X=Y,DIC="^AUTTVNDR("_BMCPROV_",""MP"",",DIC(0)="ELMQZ"
D ^DIC
G MPADD:Y=-1
S DA=+Y
W !
S DIE("NO^")="",DIE="^AUTTVNDR("_BMCPROV_",""MP"",",DA(1)=BMCPROV,DR="2;3;4"
D ^DIE
K DIE,DA
G END
;
MPEDIT ;
W !!,"Which item: "
D READ^BMC
G END:$D(DUOUT)
I Y?1"?".E W !!?3,"Enter 1 thru ",CT G MPEDIT
I Y="" G MPEDIT
I Y'?1N.N!(Y>CT) W !!,"Enter 1 thru ",CT G MPEDIT
S X=$P(BMCDSP(Y),U)
S DA(1)=BMCPROV,DIC="^AUTTVNDR("_BMCPROV_",""MP"",",DIC(0)="ELMQZ"
D ^DIC
G MPADD:Y=-1
S DA=+Y
W !
S DIE("NO^")="",DIE="^AUTTVNDR("_BMCPROV_",""MP"",",DA(1)=BMCPROV,DR=".01;2;3;4"
D ^DIE
K DIE,DA
G END
G END:'Y
BMCVDV1 ; IHS/OIT/FCJ - SELECT CONTRACT NUMBER ; [ 10/15/2004 3:02 PM ]
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**5**;JAN 09, 2006;Build 101
+2 ;BMC*4.0*5 5.13.2009 IHS.OIT.FCJ ORIGIAL ROUTINE FR ACHSVDV1
+3 ;
A4 ;EP
+1 IF '$DATA(^AUTTVNDR(BMCPROV,"CN"))
GOTO A6
+2 KILL BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
+3 ;
+4 SET Y=$$DIR^XBDIR("Y","Want to see Vendor Contract Information","NO","","","",2)
+5 IF $DATA(DTOUT)
GOTO END^BMCVDV
IF $DATA(DUOUT)
GOTO A1^BMCVDV
IF 'Y
GOTO A6
+6 SET BMCACO="L"
SET P=BMCPROV
SET A("DISPLAY")=1
SET BMCCTFL=""
+7 DO L^BMCVDV1
A6 ;
+1 IF BMCRT("RQ")<0
GOTO A7
+2 SET Y=$$DIR^XBDIR("Y","Want to see Vendor Rate Quotation Information","NO","","","",2)
+3 IF $DATA(DTOUT)
GOTO END^BMCVDV
IF $DATA(DUOUT)
GOTO A1^BMCVDV
IF 'Y
GOTO A7
+4 SET BMCAGTP="RQ"
SET BMCRQFL=""
+5 DO AGRDSP^BMCVDV2
A7 ;
+1 IF '$DATA(BMCRT("PA"))
GOTO A8
+2 SET Y=$$DIR^XBDIR("Y","Want to see Vendor Agreement Information","NO","","","",2)
+3 IF $DATA(DTOUT)
GOTO END^BMCVDV
IF $DATA(DUOUT)
GOTO A1^BMCVDV
IF 'Y
GOTO A8
+4 SET BMCAGTP="PA"
SET BMCPAFL=""
+5 DO AGRDSP^BMCVDV2
A8 ;
+1 IF '$DATA(BMCRT("BPA"))
GOTO A9
+2 SET Y=$$DIR^XBDIR("Y","Want to see Vendor BPA Information","NO","","","",2)
+3 IF $DATA(DTOUT)
GOTO END^BMCVDV
IF $DATA(DUOUT)
GOTO A1^BMCVDV
IF 'Y
GOTO A9
+4 SET BMCAGTP="BPA"
SET BMCBPFL=""
+5 DO AGRDSP^BMCVDV2
A9 ;
+1 IF '$DATA(^XUSEC("BMCZVEN",DUZ))
IF '$$DIR^XBDIR("E")
GOTO END^BMCVDV
+2 GOTO A1^BMCVDV
+3 ;
L ;EP
+1 SET E=9999999-DT
SET (S,C,L)=""
+2 IF '$DATA(BMCACO)
SET BMCACO=""
L1 ;
+1 SET S=$ORDER(^AUTTVNDR(BMCPROV,"E",S))
+2 IF S=""
GOTO L3
+3 SET N=""
L2 ;
+1 SET N=$ORDER(^AUTTVNDR(BMCPROV,"E",S,N))
+2 IF N=""
GOTO L1
IF '$DATA(^AUTTVNDR(BMCPROV,"CN",N,0))
GOTO L2
+3 SET I=$PIECE(^AUTTVNDR(BMCPROV,"CN",N,0),U)
SET C=C+1
SET L=N_U_S_U_I
IF BMCACO["L"
IF C=1
DO SBT
WRITE !,$JUSTIFY(C,2),?3,$JUSTIFY($PIECE(^(0),U),18)
SET D=$PIECE(^(0),U,2,3)
DO SBD
SET C(C)=N
+4 IF BMCACO["F"
IF C=F
GOTO L3
+5 IF $Y>24
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF Y=0
QUIT
KILL DIR
DO SBT
+6 GOTO L2
+7 ;
L3 ;
+1 IF '$DATA(^XUSEC("BMCZVEN",DUZ))
GOTO END
IF '$DATA(^AUTTVNDR(BMCPROV,"CN"))
GOTO NEW
IF $PIECE(^AUTTVNDR(BMCPROV,"CN",0),U,4)<1!(A("DISPLAY"))!(+C<1)
GOTO NEW
+2 WRITE !!,"Which one: "
+3 DO READ^BMC
+4 IF $DATA(DUOUT)
GOTO END
+5 IF Y?1"?".E
WRITE !!?3,"Enter 1 thru ",C
GOTO L3
+6 IF Y=""
GOTO NEW
+7 IF Y'?1N.N!(Y>C)
WRITE !!,"Enter 1 thru ",C
GOTO L3
+8 SET DA=C(Y)
END ;
+1 KILL C,N,S,BMCCTFL,BMCRQFL,BMCPAFL,BMCBPFL
+2 QUIT
+3 ;
SBD ;
+1 WRITE ?22,$$FMTE^XLFDT($PIECE(D,U)),?35,$$FMTE^XLFDT($PIECE(D,U,2)),?49,$EXTRACT($PIECE(^AUTTVNDR(BMCPROV,"CN",N,0),U,5),1,30)
+2 QUIT
+3 ;
SBT ;EP
+1 WRITE @IOF,!!?5,"Contract Number",?22,"Begin Date",?35,"Ending Date",?49,"Description of Service",!?5,"---------------",?22,"------------",?35,"------------",?49,"-------------------------"
+2 QUIT
+3 ;
NEW ;
+1 IF +C<1
WRITE !!,"No Contracts on file."
+2 IF $DATA(BMCCTFL)
SET DA=""
GOTO END
+3 WRITE !!,"Want to Enter a New Contract? NO// "
+4 DO READ^BMC
+5 IF $DATA(DUOUT)
GOTO END
+6 SET Y=$EXTRACT(Y_"N")
SET Y=$$UP^XLFSTR(Y)
+7 IF Y?1"?".E
DO YN^BMC
GOTO NEW
+8 IF Y=""!(Y?1"N".E)
SET DA=""
GOTO END
+9 IF Y'?1"Y".E
DO YN^BMC
GOTO NEW
NEW1 ;
+1 WRITE !!,"Enter CONTRACT NUMBER: "
+2 DO READ^BMC
+3 IF $DATA(DUOUT)
GOTO NEW
+4 IF Y?1"?".E
WRITE !!,"Enter New Contract Number "
GOTO NEW1
+5 IF Y=""
GOTO NEW
+6 IF '$DATA(^AUTTVNDR(BMCPROV,"CN",0))
SET ^(0)="^9999999.1112^"
+7 SET DA(1)=BMCPROV
SET X=Y
SET DIC="^AUTTVNDR("_BMCPROV_",""CN"","
SET DIC(0)="ELMQZ"
+8 DO ^DIC
+9 IF Y=-1
GOTO NEW
+10 SET DA=+Y
+11 WRITE !
+12 SET DIE("NO^")=""
SET DIE="^AUTTVNDR("_BMCPROV_",""CN"","
SET DA(1)=BMCPROV
SET DR="1;2;4;3"
+13 DO ^DIE
+14 KILL DIE,DA
+15 GOTO END
+16 ;
MP ;EP
+1 WRITE @IOF
DO MPDSP
+2 SET (BMCMP,CT)=0
+3 FOR I=1:1
SET BMCMP=$ORDER(^AUTTVNDR(BMCPROV,"MP",BMCMP))
IF BMCMP'>0
QUIT
Begin DoDot:1
+4 SET BMCDSP(I)=^AUTTVNDR(BMCPROV,"MP",BMCMP,0)
+5 IF BMCDSP(I)'=""
SET CT=CT+1
SET BMCMPN=$PIECE(BMCDSP(I),U)
SET BMCBDT=$PIECE(BMCDSP(I),U,3)
SET BMCEDT=$PIECE(BMCDSP(I),U,4)
SET BMCDES=$PIECE(BMCDSP(I),U,2)
+6 IF $DATA(BMCDES)
SET BMCDES=$$EXTSET^XBFUNC(9999999.112303,2,BMCDES)
+7 WRITE ?2,CT,?6,$GET(BMCMPN),?23,$$FMTE^XLFDT($GET(BMCBDT)),?37,$$FMTE^XLFDT($GET(BMCEDT)),?51,$GET(BMCDES),!
End DoDot:1
+8 IF CT=0
WRITE !!,?6,"No Medicare Numbers listed.",!
GOTO ASK1
+9 IF CT>0
GOTO ASK1
+10 QUIT
+11 ;
MPDSP ;DISPLAY MEDICARE PROVIDER INFO
+1 WRITE !!,"Item",?6,"Medicare Number",?23,"Begin Date",?37,"End Date",?51,"Description",!,"----",?6,"---------------",?23,"------------",?37,"------------",?51,"-------------------------",!
+2 QUIT
+3 ;
ASK1 ;
+1 SET Y=$$DIR^XBDIR("Y","Want to add Medicare Information","NO","","","",2)
+2 IF $DATA(DUOUT)
GOTO END
IF 'Y
GOTO ASK2
+3 IF Y
GOTO MPADD
ASK2 ;
+1 SET Y=$$DIR^XBDIR("Y","Want to edit Medicare Information","NO","","","",2)
+2 IF $DATA(DUOUT)
GOTO END
IF 'Y
GOTO END
+3 IF Y
GOTO MPEDIT
MPADD ;
+1 WRITE !!,"Enter the Medicare NUMBER: "
+2 DO READ^BMC
+3 IF $DATA(DUOUT)
GOTO END
+4 IF Y?1"?".E
WRITE !!,"Enter New Number "
GOTO MPADD
+5 IF '$DATA(^AUTTVNDR(BMCPROV,"MP",0))
SET ^(0)="^9999999.112303^"
+6 SET DA(1)=BMCPROV
SET X=Y
SET DIC="^AUTTVNDR("_BMCPROV_",""MP"","
SET DIC(0)="ELMQZ"
+7 DO ^DIC
+8 IF Y=-1
GOTO MPADD
+9 SET DA=+Y
+10 WRITE !
+11 SET DIE("NO^")=""
SET DIE="^AUTTVNDR("_BMCPROV_",""MP"","
SET DA(1)=BMCPROV
SET DR="2;3;4"
+12 DO ^DIE
+13 KILL DIE,DA
+14 GOTO END
+15 ;
MPEDIT ;
+1 WRITE !!,"Which item: "
+2 DO READ^BMC
+3 IF $DATA(DUOUT)
GOTO END
+4 IF Y?1"?".E
WRITE !!?3,"Enter 1 thru ",CT
GOTO MPEDIT
+5 IF Y=""
GOTO MPEDIT
+6 IF Y'?1N.N!(Y>CT)
WRITE !!,"Enter 1 thru ",CT
GOTO MPEDIT
+7 SET X=$PIECE(BMCDSP(Y),U)
+8 SET DA(1)=BMCPROV
SET DIC="^AUTTVNDR("_BMCPROV_",""MP"","
SET DIC(0)="ELMQZ"
+9 DO ^DIC
+10 IF Y=-1
GOTO MPADD
+11 SET DA=+Y
+12 WRITE !
+13 SET DIE("NO^")=""
SET DIE="^AUTTVNDR("_BMCPROV_",""MP"","
SET DA(1)=BMCPROV
SET DR=".01;2;3;4"
+14 DO ^DIE
+15 KILL DIE,DA
+16 GOTO END
+17 IF 'Y
GOTO END
