ACHSVDV ; IHS/ITSC/PMF - 1/2 VIEW/EDIT PROVIDER-VENDOR FILE ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,11,13,19,23,24**;JUN 11, 2001;Build 43
;ITSC/SET/JVK ACHS*3.1*6 MODIFIED TO DISPLAY ACTUAL CONTENT OF FIELD
;ITSC/SET/JVK ACHS*3.1*11 MODIFIED TO DISPLAY MEDICARE PROVIDER
;ACHS*3.1*13 11/29/06 IHS/OIT/FCJ FORMAT CHANGES AND ADDED DUNS NUMBER OPTION 11
;
A1 ;EP
D LINES^ACHSFU,HDR
S DIC(0)="AEQMZ"_$S($D(^XUSEC("ACHSZMGR",DUZ)):"L",1:""),DIC="^AUTTVNDR(",DIC("A")="Enter Provider/Vendor: "
S:DIC(0)["L" DLAYGO=9999999.11
D ^DIC
K DIC,DLAYGO
G END:Y=-1
S ACHSPROV=+Y
G ^ACHSVDVD
;
A1A ;EP
S:'$D(^AUTTVNDR(ACHSPROV,11))#2 ^AUTTVNDR(ACHSPROV,11)=""
S:'$D(^AUTTVNDR(ACHSPROV,13))#2 ^AUTTVNDR(ACHSPROV,13)=""
A2 ;EP
Q:'$D(ACHSPROV)
S ACHS0=$G(^AUTTVNDR(ACHSPROV,0)),ACHS11=$S($D(^AUTTVNDR(ACHSPROV,11)):^(11),1:""),ACHS13=$S($D(^AUTTVNDR(ACHSPROV,13)):^(13),1:""),ACHS17=$S($D(^AUTTVNDR(ACHSPROV,17)):^(17),1:"")
I $D(^AUTTVNDR(ACHSPROV,11)),$P($G(^AUTTVNDR(ACHSPROV,11)),U)="" G MESSAGE^ACHSVDVD
D HDR
S ACHSVT=$P(ACHS11,U,3),(ACHSDAP,ACHSLAD,ACHSDISP)=""
S %=$O(^ACHSVPMT(DUZ(2),1,"B",ACHSPROV,0))
I %,$D(^ACHSVPMT(DUZ(2),1,%,1,ACHSCFY,0)) S ACHSDAP=$P(^(0),U,2),ACHSLAD=$P(^(0),U,3)
I ACHSVT]"",ACHSVT?1N.N S ACHSVT=$P(^AUTTVTYP(+ACHSVT,0),U,2)
S ACHSEDOS=DT
K ACHSRT,ACHSCTNA
D A1^ACHSURT
S ACHSLAD=$$FMTE^XLFDT(ACHSLAD),ACHSACO="",P=ACHSPROV
D ^ACHSUCN
K ACHSRT,ACHSCTNA
D A1^ACHSURT
S ACHSMS=$P(ACHS13,U,3)
I ACHSMS?1N.N S ACHSMS=$P(^DIC(5,ACHSMS,0),U)
S ACHSBS=$P(ACHS13,U,8)
I ACHSBS?1N.N S ACHSBS=$P(^DIC(5,ACHSBS,0),U)
;ACHS*3.1*13 11/29/06 IHS/OIT/FCJ FORMAT CHANGES AND ADDED DUNS NUMBER OPTION 11
W !," 1) ",$P(^AUTTVNDR(ACHSPROV,0),U),?46," 2) EIN No: ",$P(ACHS11,U),$S($P(ACHS11,U,2)]"":"-"_$P(ACHS11,U,2),1:"")
W !," 3) Status: ",$S(+$P(ACHS0,U,5):"IN",1:""),"ACTIVE"
W ?46," 4) Contracts: ",$S(ACHSACO="N":"NONE ACTIVE",+C>0:"ACTIVE="_+C,1:"NONE")
I '$D(ACHSRT("RQ")) S ACHSRT("RQ")=-1
W !," 5) UPIN: ",$P(ACHS17,U),?46," 6) Rate Quotation: ",$S('$D(ACHSRT("RQ")):"NONE",'$D(ACHSRT("RQ","ACTIVE")):"NONE ACTIVE",ACHSRT("RQ","ACTIVE")>0:"ACTIVE="_+$P(ACHSRT("RQ","ACTIVE"),U,1),1:"")
W !," 7) Type of Business: "
S X=$P(ACHS11,U,26)
I X W $P($G(^AUTTTOB(X,0)),U)
W ?46," 8) Agreement: ",$S('$D(ACHSRT("PA")):"NONE",'$D(ACHSRT("PA","ACTIVE")):"NONE ACTIVE",ACHSRT("PA","ACTIVE")>0:"ACTIVE="_+$P(ACHSRT("PA","ACTIVE"),U,1),1:"")
;IHS/SET/JVK ACHS*3.1*11 ADD MEDICARE PROVIDER FIELD NUMBER 9
I $D(^AUTTVNDR(ACHSPROV,23)) S ACHSMP=$P($G(^(23)),U) S ACHMP=$$EXTSET^XBFUNC(9999999.11,2301,ACHSMP)
I '$D(^AUTTVNDR(ACHSPROV,23)) S ACHSMP=""
W !," 9) Medicare Provider: ",$S(ACHSMP="":"No entry",ACHSMP'="":ACHSMP,1:"")
W ?46,"10) BPA: ",$S('$D(ACHSRT("BPA")):"NONE",'$D(ACHSRT("BPA","ACTIVE")):"NONE ACTIVE",ACHSRT("BPA","ACTIVE")>0:"ACTIVE="_+$P(ACHSRT("BPA","ACTIVE"),U,1),1:"")
W !,"11) E-Mail: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2103) ;ACHS*3.1*19
W ?46,"12) DUNS: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,.07)
W !,"13) Direct Participant: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2104) ;ACHS*3.1*23 IHS.OIT.FCJ
W !,"14) Direct E-Mail: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2105) ;ACHS*3.1*23 IHS.OIT.FCJ
W !!,"**** MAILING/BILLING ADDRESS ****",?44,"**** PROVIDER LOCATION ADDRESS ****"
W !,"15) Street: ",$P(ACHS13,U),?46,"16) Street: ",$E($P(ACHS13,U,6),1,17)
;ACHS*3.1*19 CHANGES TO NXT 2 LINES TO DISPLAY FAX NUM
W !?6,"City: ",$P(ACHS13,U,2),?52,"City: ",$P(ACHS13,U,7),!?5,"State: ",ACHSMS,?26,"Zip: ",$P(ACHS13,U,4),?51,"State: ",ACHSBS
W !?5,"Phone: ",$P(ACHS11,U,9),?26,"Fax: ",$P(ACHS11,U,14),?48,"Zip Code: ",$P(ACHS13,U,9),!?6,"Attn: ",$P(ACHS13,U,5)
W !,"17) Vendor Type: ",ACHSVT
;IHS/SET/JVK ACHS*3.1*6 MODIFIED TO DISPLAY ACTUAL CONTENT OF FIELD
;W ?48,"(13). Fed/Non-Fed: ",$S($P(ACHS11,U,10)=1:"NON-",$P(ACHS11,U,10)=2:"",1:"NON-"),"FED"
W ?46,"18) Fed/Non-Fed: ",$S($P(ACHS11,U,10)=1:"NON-FED",$P(ACHS11,U,10)=2:"FED",$P(ACHS11,U,10)="":"")
W !,"19) Specialty: ",$S($P(ACHS11,U,4):$P(^DIC(7,$P(ACHS11,U,4),0),U),1:"")
;IHS/SET/JVK ACHS*3.1*6 ADD GEOGRAPHICAL LOCATION 4/15/2003
W ?46,"20) Geographic Loc: ",$S($P(ACHS11,U,25)="":"",$P(ACHS11,U,25):$P(^AUTTGL($P(ACHS11,U,25),0),U))
W !?2,"Last Payment Date: ",ACHSLAD,?45,"Current FYTD Paid: "
I ACHSDAP]"" S X=ACHSDAP,X2="2$" D FMT^ACHS
W !,$$REPEAT^XLFSTR("*",79)
G:'$D(^XUSEC("ACHSZMGR",DUZ)) A4^ACHSVDV1
;ITSC/SET/JVK ACHS*3.1*11 ENTRY POINT 13 ;ACHS*3.1*13 IHS/OIT/FCJ IS NOW 14;ACHS*3.1*22 IS NOW 15;ACHS*3.1*24 IS NOW 17;
;I ACHSVT="" W *7,!!,"MUST HAVE VENDOR TYPE." D 12^ACHSVDVA G A2:'$D(Y),A1
I ACHSVT="" W *7,!!,"MUST HAVE VENDOR TYPE." D 17^ACHSVDVA G A2:'$D(Y),A1
A3 ;
K ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
S Y=$$DIR^XBDIR("Y","Want to Edit","NO","","","",1)
G END:$D(DTOUT),A1:$D(DUOUT),A4^ACHSVDV1:('Y),EDIT^ACHSVDVA:Y
G A3
;
END ;EP
K X,P,S,C,L,D,D0,DA,DI,DIC,DR
D EN^XBVK("ACHS"),^ACHSVAR
Q
;
HDR ;
S X="PROVIDER/VENDOR UPDATE",Y="ACHS"
D SHDR^ACHS
W $$REPEAT^XLFSTR("*",79) ;ACHS 3.1*13 11/29/06 IHS/OIT/FCJ REMOVED !
Q
;
ACHSVDV ; IHS/ITSC/PMF - 1/2 VIEW/EDIT PROVIDER-VENDOR FILE ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,11,13,19,23,24**;JUN 11, 2001;Build 43
+2 ;ITSC/SET/JVK ACHS*3.1*6 MODIFIED TO DISPLAY ACTUAL CONTENT OF FIELD
+3 ;ITSC/SET/JVK ACHS*3.1*11 MODIFIED TO DISPLAY MEDICARE PROVIDER
+4 ;ACHS*3.1*13 11/29/06 IHS/OIT/FCJ FORMAT CHANGES AND ADDED DUNS NUMBER OPTION 11
+5 ;
A1 ;EP
+1 DO LINES^ACHSFU
DO HDR
+2 SET DIC(0)="AEQMZ"_$SELECT($DATA(^XUSEC("ACHSZMGR",DUZ)):"L",1:"")
SET DIC="^AUTTVNDR("
SET DIC("A")="Enter Provider/Vendor: "
+3 IF DIC(0)["L"
SET DLAYGO=9999999.11
+4 DO ^DIC
+5 KILL DIC,DLAYGO
+6 IF Y=-1
GOTO END
+7 SET ACHSPROV=+Y
+8 GOTO ^ACHSVDVD
+9 ;
A1A ;EP
+1 IF '$DATA(^AUTTVNDR(ACHSPROV,11))#2
SET ^AUTTVNDR(ACHSPROV,11)=""
+2 IF '$DATA(^AUTTVNDR(ACHSPROV,13))#2
SET ^AUTTVNDR(ACHSPROV,13)=""
A2 ;EP
+1 IF '$DATA(ACHSPROV)
QUIT
+2 SET ACHS0=$GET(^AUTTVNDR(ACHSPROV,0))
SET ACHS11=$SELECT($DATA(^AUTTVNDR(ACHSPROV,11)):^(11),1:"")
SET ACHS13=$SELECT($DATA(^AUTTVNDR(ACHSPROV,13)):^(13),1:"")
SET ACHS17=$SELECT($DATA(^AUTTVNDR(ACHSPROV,17)):^(17),1:"")
+3 IF $DATA(^AUTTVNDR(ACHSPROV,11))
IF $PIECE($GET(^AUTTVNDR(ACHSPROV,11)),U)=""
GOTO MESSAGE^ACHSVDVD
+4 DO HDR
+5 SET ACHSVT=$PIECE(ACHS11,U,3)
SET (ACHSDAP,ACHSLAD,ACHSDISP)=""
+6 SET %=$ORDER(^ACHSVPMT(DUZ(2),1,"B",ACHSPROV,0))
+7 IF %
IF $DATA(^ACHSVPMT(DUZ(2),1,%,1,ACHSCFY,0))
SET ACHSDAP=$PIECE(^(0),U,2)
SET ACHSLAD=$PIECE(^(0),U,3)
+8 IF ACHSVT]""
IF ACHSVT?1N.N
SET ACHSVT=$PIECE(^AUTTVTYP(+ACHSVT,0),U,2)
+9 SET ACHSEDOS=DT
+10 KILL ACHSRT,ACHSCTNA
+11 DO A1^ACHSURT
+12 SET ACHSLAD=$$FMTE^XLFDT(ACHSLAD)
SET ACHSACO=""
SET P=ACHSPROV
+13 DO ^ACHSUCN
+14 KILL ACHSRT,ACHSCTNA
+15 DO A1^ACHSURT
+16 SET ACHSMS=$PIECE(ACHS13,U,3)
+17 IF ACHSMS?1N.N
SET ACHSMS=$PIECE(^DIC(5,ACHSMS,0),U)
+18 SET ACHSBS=$PIECE(ACHS13,U,8)
+19 IF ACHSBS?1N.N
SET ACHSBS=$PIECE(^DIC(5,ACHSBS,0),U)
+20 ;ACHS*3.1*13 11/29/06 IHS/OIT/FCJ FORMAT CHANGES AND ADDED DUNS NUMBER OPTION 11
+21 WRITE !," 1) ",$PIECE(^AUTTVNDR(ACHSPROV,0),U),?46," 2) EIN No: ",$PIECE(ACHS11,U),$SELECT($PIECE(ACHS11,U,2)]"":"-"_$PIECE(ACHS11,U,2),1:"")
+22 WRITE !," 3) Status: ",$SELECT(+$PIECE(ACHS0,U,5):"IN",1:""),"ACTIVE"
+23 WRITE ?46," 4) Contracts: ",$SELECT(ACHSACO="N":"NONE ACTIVE",+C>0:"ACTIVE="_+C,1:"NONE")
+24 IF '$DATA(ACHSRT("RQ"))
SET ACHSRT("RQ")=-1
+25 WRITE !," 5) UPIN: ",$PIECE(ACHS17,U),?46," 6) Rate Quotation: ",$SELECT('$DATA(ACHSRT("RQ")):"NONE",'$DATA(ACHSRT("RQ","ACTIVE")):"NONE ACTIVE",ACHSRT("RQ","ACTIVE")>0:"ACTIVE="_+$PIECE(ACHSRT("RQ","ACTIVE"),U,1),1:"")
+26 WRITE !," 7) Type of Business: "
+27 SET X=$PIECE(ACHS11,U,26)
+28 IF X
WRITE $PIECE($GET(^AUTTTOB(X,0)),U)
+29 WRITE ?46," 8) Agreement: ",$SELECT('$DATA(ACHSRT("PA")):"NONE",'$DATA(ACHSRT("PA","ACTIVE")):"NONE ACTIVE",ACHSRT("PA","ACTIVE")>0:"ACTIVE="_+$PIECE(ACHSRT("PA","ACTIVE"),U,1),1:"")
+30 ;IHS/SET/JVK ACHS*3.1*11 ADD MEDICARE PROVIDER FIELD NUMBER 9
+31 IF $DATA(^AUTTVNDR(ACHSPROV,23))
SET ACHSMP=$PIECE($GET(^(23)),U)
SET ACHMP=$$EXTSET^XBFUNC(9999999.11,2301,ACHSMP)
+32 IF '$DATA(^AUTTVNDR(ACHSPROV,23))
SET ACHSMP=""
+33 WRITE !," 9) Medicare Provider: ",$SELECT(ACHSMP="":"No entry",ACHSMP'="":ACHSMP,1:"")
+34 WRITE ?46,"10) BPA: ",$SELECT('$DATA(ACHSRT("BPA")):"NONE",'$DATA(ACHSRT("BPA","ACTIVE")):"NONE ACTIVE",ACHSRT("BPA","ACTIVE")>0:"ACTIVE="_+$PIECE(ACHSRT("BPA","ACTIVE"),U,1),1:"")
+35 ;ACHS*3.1*19
WRITE !,"11) E-Mail: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2103)
+36 WRITE ?46,"12) DUNS: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,.07)
+37 ;ACHS*3.1*23 IHS.OIT.FCJ
WRITE !,"13) Direct Participant: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2104)
+38 ;ACHS*3.1*23 IHS.OIT.FCJ
WRITE !,"14) Direct E-Mail: ",$$VAL^XBDIQ1(9999999.11,ACHSPROV,2105)
+39 WRITE !!,"**** MAILING/BILLING ADDRESS ****",?44,"**** PROVIDER LOCATION ADDRESS ****"
+40 WRITE !,"15) Street: ",$PIECE(ACHS13,U),?46,"16) Street: ",$EXTRACT($PIECE(ACHS13,U,6),1,17)
+41 ;ACHS*3.1*19 CHANGES TO NXT 2 LINES TO DISPLAY FAX NUM
+42 WRITE !?6,"City: ",$PIECE(ACHS13,U,2),?52,"City: ",$PIECE(ACHS13,U,7),!?5,"State: ",ACHSMS,?26,"Zip: ",$PIECE(ACHS13,U,4),?51,"State: ",ACHSBS
+43 WRITE !?5,"Phone: ",$PIECE(ACHS11,U,9),?26,"Fax: ",$PIECE(ACHS11,U,14),?48,"Zip Code: ",$PIECE(ACHS13,U,9),!?6,"Attn: ",$PIECE(ACHS13,U,5)
+44 WRITE !,"17) Vendor Type: ",ACHSVT
+45 ;IHS/SET/JVK ACHS*3.1*6 MODIFIED TO DISPLAY ACTUAL CONTENT OF FIELD
+46 ;W ?48,"(13). Fed/Non-Fed: ",$S($P(ACHS11,U,10)=1:"NON-",$P(ACHS11,U,10)=2:"",1:"NON-"),"FED"
+47 WRITE ?46,"18) Fed/Non-Fed: ",$SELECT($PIECE(ACHS11,U,10)=1:"NON-FED",$PIECE(ACHS11,U,10)=2:"FED",$PIECE(ACHS11,U,10)="":"")
+48 WRITE !,"19) Specialty: ",$SELECT($PIECE(ACHS11,U,4):$PIECE(^DIC(7,$PIECE(ACHS11,U,4),0),U),1:"")
+49 ;IHS/SET/JVK ACHS*3.1*6 ADD GEOGRAPHICAL LOCATION 4/15/2003
+50 WRITE ?46,"20) Geographic Loc: ",$SELECT($PIECE(ACHS11,U,25)="":"",$PIECE(ACHS11,U,25):$PIECE(^AUTTGL($PIECE(ACHS11,U,25),0),U))
+51 WRITE !?2,"Last Payment Date: ",ACHSLAD,?45,"Current FYTD Paid: "
+52 IF ACHSDAP]""
SET X=ACHSDAP
SET X2="2$"
DO FMT^ACHS
+53 WRITE !,$$REPEAT^XLFSTR("*",79)
+54 IF '$DATA(^XUSEC("ACHSZMGR",DUZ))
GOTO A4^ACHSVDV1
+55 ;ITSC/SET/JVK ACHS*3.1*11 ENTRY POINT 13 ;ACHS*3.1*13 IHS/OIT/FCJ IS NOW 14;ACHS*3.1*22 IS NOW 15;ACHS*3.1*24 IS NOW 17;
+56 ;I ACHSVT="" W *7,!!,"MUST HAVE VENDOR TYPE." D 12^ACHSVDVA G A2:'$D(Y),A1
+57 IF ACHSVT=""
WRITE *7,!!,"MUST HAVE VENDOR TYPE."
DO 17^ACHSVDVA
IF '$DATA(Y)
GOTO A2
GOTO A1
A3 ;
+1 KILL ACHSCTFL,ACHSRQFL,ACHSPAFL,ACHSBPFL
+2 SET Y=$$DIR^XBDIR("Y","Want to Edit","NO","","","",1)
+3 IF $DATA(DTOUT)
GOTO END
IF $DATA(DUOUT)
GOTO A1
IF ('Y)
GOTO A4^ACHSVDV1
IF Y
GOTO EDIT^ACHSVDVA
+4 GOTO A3
+5 ;
END ;EP
+1 KILL X,P,S,C,L,D,D0,DA,DI,DIC,DR
+2 DO EN^XBVK("ACHS")
DO ^ACHSVAR
+3 QUIT
+4 ;
HDR ;
+1 SET X="PROVIDER/VENDOR UPDATE"
SET Y="ACHS"
+2 DO SHDR^ACHS
+3 ;ACHS 3.1*13 11/29/06 IHS/OIT/FCJ REMOVED !
WRITE $$REPEAT^XLFSTR("*",79)
+4 QUIT
+5 ;
