ACHSVDV1 ; IHS/ITSC/JVK - SELECT CONTRACT NUMBER ; [ 10/15/2004 3:02 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**11,15**;JUNE 11, 2001
;ITSC/SET/JVK ACHS*3.1*11 MODIFIED TO DISPLAY MEDICARE PROVIDER INFO
;ACHS*3.1*15 OIT.IHS.FCJ CHANGED TO ACCOMODATE THE 18 CHAR CONTRACT NUMBER
;
A4 ;EP
G A6:'$D(^AUTTVNDR(ACHSPROV,"CN"))
K ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
;
S Y=$$DIR^XBDIR("Y","Want to see Vendor Contract Information","NO","","","",2)
G END^ACHSVDV:$D(DTOUT),A1^ACHSVDV:$D(DUOUT),A6:'Y
S ACHSACO="L",P=ACHSPROV,A("DISPLAY")=1,ACHSCTFL=""
D L^ACHSVDV1
A6 ;
G:ACHSRT("RQ")<0 A7
S Y=$$DIR^XBDIR("Y","Want to see Vendor Rate Quotation Information","NO","","","",2)
G END^ACHSVDV:$D(DTOUT),A1^ACHSVDV:$D(DUOUT),A7:'Y
S ACHSAGTP="RQ",ACHSRQFL=""
D AGRDSP^ACHSVDV2
A7 ;
G:'$D(ACHSRT("PA")) A8
S Y=$$DIR^XBDIR("Y","Want to see Vendor Agreement Information","NO","","","",2)
G END^ACHSVDV:$D(DTOUT),A1^ACHSVDV:$D(DUOUT),A8:'Y
S ACHSAGTP="PA",ACHSPAFL=""
D AGRDSP^ACHSVDV2
A8 ;
G:'$D(ACHSRT("BPA")) A9
S Y=$$DIR^XBDIR("Y","Want to see Vendor BPA Information","NO","","","",2)
G END^ACHSVDV:$D(DTOUT),A1^ACHSVDV:$D(DUOUT),A9:'Y
S ACHSAGTP="BPA",ACHSBPFL=""
D AGRDSP^ACHSVDV2
A9 ;
S Y=$$DIR^XBDIR("Y","Want to see Prior FY Payments for this Vendor","NO","","","",2)
G A1^ACHSVDV:$D(DTOUT)!$D(DUOUT)!('Y)
D ^ACHSVDV2
I $$DIR^XBDIR("E","Press RETURN...","","","","",1)
G A1^ACHSVDV
;
L ;EP
S E=9999999-DT,(S,C,L)=""
I '$D(ACHSACO) S ACHSACO=""
L1 ;
S S=$O(^AUTTVNDR(ACHSPROV,"E",S))
G L3:S=""
S N=""
L2 ;
S N=$O(^AUTTVNDR(ACHSPROV,"E",S,N))
G L1:N="",L2:'$D(^AUTTVNDR(ACHSPROV,"CN",N,0))
;ACHS*3.1*15 OIT.IHS.FCJ CHANGED TO ACCOMODATE THE 18 CHAR CONTRACT NUMBER
;S I=$P(^AUTTVNDR(ACHSPROV,"CN",N,0),U),C=C+1,L=N_U_S_U_I I ACHSACO["L" D SBT:C=1 W !,$J(C,4),?4,$J($P(^(0),U),15) S D=$P(^(0),U,2,3) D SBD S C(C)=N
S I=$P(^AUTTVNDR(ACHSPROV,"CN",N,0),U),C=C+1,L=N_U_S_U_I I ACHSACO["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 ACHSACO["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("ACHSZMGR",DUZ)),NEW:'$D(^AUTTVNDR(ACHSPROV,"CN")),NEW:$P(^AUTTVNDR(ACHSPROV,"CN",0),U,4)<1!(A("DISPLAY"))!(+C<1)
W !!,"Which one: "
D READ^ACHSFU
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,ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
Q
;
SBD ;
W ?22,$$FMTE^XLFDT($P(D,U)),?35,$$FMTE^XLFDT($P(D,U,2)),?49,$E($P(^AUTTVNDR(ACHSPROV,"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(ACHSCTFL) S DA="" G END
W !!,"Want to Enter a New Contract? NO// "
D READ^ACHSFU
G END:$D(DUOUT)
S Y=$E(Y_"N"),Y=$$UP^XLFSTR(Y)
I Y?1"?".E D YN^ACHS G NEW
I Y=""!(Y?1"N".E) S DA="" G END
I Y'?1"Y".E D YN^ACHS G NEW
NEW1 ;
W !!,"Enter CONTRACT NUMBER: "
D READ^ACHSFU
G NEW:$D(DUOUT)
I Y?1"?".E W !!,"Enter New Contract Number " G NEW1
G NEW:Y=""
S:'$D(^AUTTVNDR(ACHSPROV,"CN",0)) ^(0)="^9999999.1112^"
S DA(1)=ACHSPROV,X=Y,DIC="^AUTTVNDR("_ACHSPROV_",""CN"",",DIC(0)="ELMQZ"
D ^DIC
G NEW:Y=-1
S DA=+Y
W !
S DIE("NO^")="",DIE="^AUTTVNDR("_ACHSPROV_",""CN"",",DA(1)=ACHSPROV,DR="1;2;4;3"
D ^DIE
K DIE,DA
G END
;
MP ;EP -- ITSC/SET/JVK ACHS*3.1*11 FIND MEDICARE PROVIDER INFO
W @IOF D MPDSP
S (ACHSMP,CT)=0
F I=1:1 S ACHSMP=$O(^AUTTVNDR(ACHSPROV,"MP",ACHSMP)) Q:ACHSMP'>0 D
.S ACHSDSP(I)=^AUTTVNDR(ACHSPROV,"MP",ACHSMP,0)
.I ACHSDSP(I)'="" S CT=CT+1 S ACHSMPN=$P(ACHSDSP(I),U),ACHSBDT=$P(ACHSDSP(I),U,3),ACHSEDT=$P(ACHSDSP(I),U,4),ACHSDES=$P(ACHSDSP(I),U,2)
.I $D(ACHSDES) S ACHSDES=$$EXTSET^XBFUNC(9999999.112303,2,ACHSDES)
.W ?2,CT,?6,$G(ACHSMPN),?23,$$FMTE^XLFDT($G(ACHSBDT)),?37,$$FMTE^XLFDT($G(ACHSEDT)),?51,$G(ACHSDES),!
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^ACHSFU
G END:$D(DUOUT)
I Y?1"?".E W !!,"Enter New Number " G MPADD
S:'$D(^AUTTVNDR(ACHSPROV,"MP",0)) ^(0)="^9999999.112303^"
S DA(1)=ACHSPROV,X=Y,DIC="^AUTTVNDR("_ACHSPROV_",""MP"",",DIC(0)="ELMQZ"
D ^DIC
G MPADD:Y=-1
S DA=+Y
W !
S DIE("NO^")="",DIE="^AUTTVNDR("_ACHSPROV_",""MP"",",DA(1)=ACHSPROV,DR="2;3;4"
D ^DIE
K DIE,DA
G END
;
MPEDIT ;
W !!,"Which item: "
D READ^ACHSFU
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(ACHSDSP(Y),U)
S DA(1)=ACHSPROV,DIC="^AUTTVNDR("_ACHSPROV_",""MP"",",DIC(0)="ELMQZ"
D ^DIC
G MPADD:Y=-1
S DA=+Y
W !
S DIE("NO^")="",DIE="^AUTTVNDR("_ACHSPROV_",""MP"",",DA(1)=ACHSPROV,DR=".01;2;3;4"
D ^DIE
K DIE,DA
G END
G END:'Y
;ITSC/SET/JVK ACHS*3.1*11 END FOR ADDITIONS FOR MEDICARE PROV. NO.
ACHSVDV1 ; IHS/ITSC/JVK - SELECT CONTRACT NUMBER ; [ 10/15/2004 3:02 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**11,15**;JUNE 11, 2001
+2 ;ITSC/SET/JVK ACHS*3.1*11 MODIFIED TO DISPLAY MEDICARE PROVIDER INFO
+3 ;ACHS*3.1*15 OIT.IHS.FCJ CHANGED TO ACCOMODATE THE 18 CHAR CONTRACT NUMBER
+4 ;
A4 ;EP
+1 IF '$DATA(^AUTTVNDR(ACHSPROV,"CN"))
GOTO A6
+2 KILL ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
+3 ;
+4 SET Y=$$DIR^XBDIR("Y","Want to see Vendor Contract Information","NO","","","",2)
+5 IF $DATA(DTOUT)
GOTO END^ACHSVDV
IF $DATA(DUOUT)
GOTO A1^ACHSVDV
IF 'Y
GOTO A6
+6 SET ACHSACO="L"
SET P=ACHSPROV
SET A("DISPLAY")=1
SET ACHSCTFL=""
+7 DO L^ACHSVDV1
A6 ;
+1 IF ACHSRT("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^ACHSVDV
IF $DATA(DUOUT)
GOTO A1^ACHSVDV
IF 'Y
GOTO A7
+4 SET ACHSAGTP="RQ"
SET ACHSRQFL=""
+5 DO AGRDSP^ACHSVDV2
A7 ;
+1 IF '$DATA(ACHSRT("PA"))
GOTO A8
+2 SET Y=$$DIR^XBDIR("Y","Want to see Vendor Agreement Information","NO","","","",2)
+3 IF $DATA(DTOUT)
GOTO END^ACHSVDV
IF $DATA(DUOUT)
GOTO A1^ACHSVDV
IF 'Y
GOTO A8
+4 SET ACHSAGTP="PA"
SET ACHSPAFL=""
+5 DO AGRDSP^ACHSVDV2
A8 ;
+1 IF '$DATA(ACHSRT("BPA"))
GOTO A9
+2 SET Y=$$DIR^XBDIR("Y","Want to see Vendor BPA Information","NO","","","",2)
+3 IF $DATA(DTOUT)
GOTO END^ACHSVDV
IF $DATA(DUOUT)
GOTO A1^ACHSVDV
IF 'Y
GOTO A9
+4 SET ACHSAGTP="BPA"
SET ACHSBPFL=""
+5 DO AGRDSP^ACHSVDV2
A9 ;
+1 SET Y=$$DIR^XBDIR("Y","Want to see Prior FY Payments for this Vendor","NO","","","",2)
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!('Y)
GOTO A1^ACHSVDV
+3 DO ^ACHSVDV2
+4 IF $$DIR^XBDIR("E","Press RETURN...","","","","",1)
+5 GOTO A1^ACHSVDV
+6 ;
L ;EP
+1 SET E=9999999-DT
SET (S,C,L)=""
+2 IF '$DATA(ACHSACO)
SET ACHSACO=""
L1 ;
+1 SET S=$ORDER(^AUTTVNDR(ACHSPROV,"E",S))
+2 IF S=""
GOTO L3
+3 SET N=""
L2 ;
+1 SET N=$ORDER(^AUTTVNDR(ACHSPROV,"E",S,N))
+2 IF N=""
GOTO L1
IF '$DATA(^AUTTVNDR(ACHSPROV,"CN",N,0))
GOTO L2
+3 ;ACHS*3.1*15 OIT.IHS.FCJ CHANGED TO ACCOMODATE THE 18 CHAR CONTRACT NUMBER
+4 ;S I=$P(^AUTTVNDR(ACHSPROV,"CN",N,0),U),C=C+1,L=N_U_S_U_I I ACHSACO["L" D SBT:C=1 W !,$J(C,4),?4,$J($P(^(0),U),15) S D=$P(^(0),U,2,3) D SBD S C(C)=N
+5 SET I=$PIECE(^AUTTVNDR(ACHSPROV,"CN",N,0),U)
SET C=C+1
SET L=N_U_S_U_I
IF ACHSACO["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
+6 IF ACHSACO["F"
IF C=F
GOTO L3
+7 IF $Y>24
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF Y=0
QUIT
KILL DIR
DO SBT
+8 GOTO L2
+9 ;
L3 ;
+1 IF '$DATA(^XUSEC("ACHSZMGR",DUZ))
GOTO END
IF '$DATA(^AUTTVNDR(ACHSPROV,"CN"))
GOTO NEW
IF $PIECE(^AUTTVNDR(ACHSPROV,"CN",0),U,4)<1!(A("DISPLAY"))!(+C<1)
GOTO NEW
+2 WRITE !!,"Which one: "
+3 DO READ^ACHSFU
+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,ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
+2 QUIT
+3 ;
SBD ;
+1 WRITE ?22,$$FMTE^XLFDT($PIECE(D,U)),?35,$$FMTE^XLFDT($PIECE(D,U,2)),?49,$EXTRACT($PIECE(^AUTTVNDR(ACHSPROV,"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(ACHSCTFL)
SET DA=""
GOTO END
+3 WRITE !!,"Want to Enter a New Contract? NO// "
+4 DO READ^ACHSFU
+5 IF $DATA(DUOUT)
GOTO END
+6 SET Y=$EXTRACT(Y_"N")
SET Y=$$UP^XLFSTR(Y)
+7 IF Y?1"?".E
DO YN^ACHS
GOTO NEW
+8 IF Y=""!(Y?1"N".E)
SET DA=""
GOTO END
+9 IF Y'?1"Y".E
DO YN^ACHS
GOTO NEW
NEW1 ;
+1 WRITE !!,"Enter CONTRACT NUMBER: "
+2 DO READ^ACHSFU
+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(ACHSPROV,"CN",0))
SET ^(0)="^9999999.1112^"
+7 SET DA(1)=ACHSPROV
SET X=Y
SET DIC="^AUTTVNDR("_ACHSPROV_",""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("_ACHSPROV_",""CN"","
SET DA(1)=ACHSPROV
SET DR="1;2;4;3"
+13 DO ^DIE
+14 KILL DIE,DA
+15 GOTO END
+16 ;
MP ;EP -- ITSC/SET/JVK ACHS*3.1*11 FIND MEDICARE PROVIDER INFO
+1 WRITE @IOF
DO MPDSP
+2 SET (ACHSMP,CT)=0
+3 FOR I=1:1
SET ACHSMP=$ORDER(^AUTTVNDR(ACHSPROV,"MP",ACHSMP))
IF ACHSMP'>0
QUIT
Begin DoDot:1
+4 SET ACHSDSP(I)=^AUTTVNDR(ACHSPROV,"MP",ACHSMP,0)
+5 IF ACHSDSP(I)'=""
SET CT=CT+1
SET ACHSMPN=$PIECE(ACHSDSP(I),U)
SET ACHSBDT=$PIECE(ACHSDSP(I),U,3)
SET ACHSEDT=$PIECE(ACHSDSP(I),U,4)
SET ACHSDES=$PIECE(ACHSDSP(I),U,2)
+6 IF $DATA(ACHSDES)
SET ACHSDES=$$EXTSET^XBFUNC(9999999.112303,2,ACHSDES)
+7 WRITE ?2,CT,?6,$GET(ACHSMPN),?23,$$FMTE^XLFDT($GET(ACHSBDT)),?37,$$FMTE^XLFDT($GET(ACHSEDT)),?51,$GET(ACHSDES),!
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^ACHSFU
+3 IF $DATA(DUOUT)
GOTO END
+4 IF Y?1"?".E
WRITE !!,"Enter New Number "
GOTO MPADD
+5 IF '$DATA(^AUTTVNDR(ACHSPROV,"MP",0))
SET ^(0)="^9999999.112303^"
+6 SET DA(1)=ACHSPROV
SET X=Y
SET DIC="^AUTTVNDR("_ACHSPROV_",""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("_ACHSPROV_",""MP"","
SET DA(1)=ACHSPROV
SET DR="2;3;4"
+12 DO ^DIE
+13 KILL DIE,DA
+14 GOTO END
+15 ;
MPEDIT ;
+1 WRITE !!,"Which item: "
+2 DO READ^ACHSFU
+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(ACHSDSP(Y),U)
+8 SET DA(1)=ACHSPROV
SET DIC="^AUTTVNDR("_ACHSPROV_",""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("_ACHSPROV_",""MP"","
SET DA(1)=ACHSPROV
SET DR=".01;2;3;4"
+14 DO ^DIE
+15 KILL DIE,DA
+16 GOTO END
+17 IF 'Y
GOTO END
+18 ;ITSC/SET/JVK ACHS*3.1*11 END FOR ADDITIONS FOR MEDICARE PROV. NO.
