ACHSVND ; IHS/ITSC/PMF - VENDOR LISTING ; [ 03/24/2005 7:49 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11, 2001
;ITSC/SET/JVK ADDED SORTS AT TYPE 3/1/05
D FY^ACHSUF
S ACHSIO=IO
TYPE ;EN - ADDED FOR ACHS*3.1*12
W !,"Select Vendor Status Type:"
W !!,?5,"1. Active"
W !,?5,"2. Inactive"
W !,?5,"3. Both//"
D READ^ACHSFU
I $G(ACHSQUIT) D K Q
G TYPE:$D(DUOUT)
S:(Y="") Y=3
I ($E(Y)="?")!(+Y<1)!(+Y>5) W !!,*7,"Enter only '1' through '3'." G TYPE
S ACHSRPT=+Y
DEV ;
S %=$$PB^ACHS
I %=U!$D(DTOUT)!$D(DUOUT) D K Q
I %="B" D VIEWR^XBLM("START^ACHSVND"),EN^XBVK("VALM"),K Q
S %ZIS="OPQ"
D ^%ZIS
I POP D HOME^%ZIS G K
G:'$D(IO("Q")) START
K IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
S ZTRTN="START^ACHSVND",ZTDESC="CHS VENDOR LISTING"
F %="ACHSCFY" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ZTSK
G K
;
START ;EP - TaskMan.
S (DA,ACHSRCT)=0,ACHSNAME=""
D BRPT^ACHSFU
D HDR
L1 ;
S ACHSNAME=$O(^AUTTVNDR("B",ACHSNAME))
G END:ACHSNAME=""
L2 ;
S DA=$O(^AUTTVNDR("B",ACHSNAME,DA))
G L1:DA=""
;ACHS*3.1*12 ADD A SORT BY STATUS NXT. 2 LINES
I ACHSRPT=1,$P(^AUTTVNDR(DA,0),U,5)>1 G L1
I ACHSRPT=2,$P(^AUTTVNDR(DA,0),U,5)="" G L1
S ACHS11=$S($D(^AUTTVNDR(DA,11)):^(11),1:""),ACHS13=$S($D(^AUTTVNDR(DA,13)):^(13),1:"")
W !,$P(ACHS11,U),?15,$E($P(^AUTTVNDR(DA,0),U),1,30),?50,$E($P(ACHS13,U),1,30),!,$E($P(ACHS13,U,2),1,15),?18,$S($P(ACHS13,U,3)]"":$P(^DIC(5,$P(ACHS13,U,3),0),U,2),1:""),?24,$P(ACHS13,U,4)
I $D(^ACHSVPMT(DUZ(2),1,DA,1,ACHSCFY,0)) W ?35,$$FMTE^XLFDT($P(^(0),U,3)),?52 S X=$P(^ACHSVPMT(DUZ(2),1,DA,1,ACHSCFY,0),U,2) D FMT^ACHS
W ?66,$P(ACHS11,U,9),!,$$REPEAT^XLFSTR("-",80)
S ACHSRCT=ACHSRCT+1
I $Y>ACHSBM D RTRN^ACHS G K:$D(DUOUT)!$D(DTOUT) D HDR
G L2
;
END ;
W !!,"NUMBER OF VENDORS = ",ACHSRCT
D RTRN^ACHS
W @IOF
K ;
K DA
D ERPT^ACHS,EN^XBVK("ACHS")
I '$D(ZTQUEUED) D ^ACHSVAR,HOME^%ZIS
Q
;
HDR ;
S ACHSPG=ACHSPG+1
;ITSC/SET/JVK ACHS*3.1*12 ADD NXT LINE AND MODIFIED FOLLWING
S ACHSRTNM=$S(ACHSRPT=1:" ACTIVE ",ACHSRPT=2:" INACTIVE ",ACHSRPT=3:" COMPLETE ")
;W @IOF,!,$$C^XBFUNC("CONTRACT HEALTH MANAGEMENT SYSTEM",80),!?24,"P R O V I D E R L I S T I N G",?71,"Page",$J(ACHSPG,3),!,ACHSLOC,!,ACHSTIME,!!,$$REPEAT^XLFSTR("*",80),!
W @IOF,!,$$C^XBFUNC("CONTRACT HEALTH MANAGEMENT SYSTEM",80),!?24,ACHSRTNM_"PROVIDER LISTING",?71,"Page",$J(ACHSPG,3),!,ACHSLOC,!,ACHSTIME,!!,$$REPEAT^XLFSTR("*",80),!
W "EIN NUMBER",?15,"PROVIDER",?50,"ADDRESS",!,"CITY",?18,"STATE",?24,"ZIP",?35,"LAST PAY DATE",?52,"YTD PAID",?66,"PHONE #",!,$$REPEAT^XLFSTR("*",80),!
Q
ACHSVND ; IHS/ITSC/PMF - VENDOR LISTING ; [ 03/24/2005 7:49 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11, 2001
+2 ;ITSC/SET/JVK ADDED SORTS AT TYPE 3/1/05
+3 DO FY^ACHSUF
+4 SET ACHSIO=IO
TYPE ;EN - ADDED FOR ACHS*3.1*12
+1 WRITE !,"Select Vendor Status Type:"
+2 WRITE !!,?5,"1. Active"
+3 WRITE !,?5,"2. Inactive"
+4 WRITE !,?5,"3. Both//"
+5 DO READ^ACHSFU
+6 IF $GET(ACHSQUIT)
DO K
QUIT
+7 IF $DATA(DUOUT)
GOTO TYPE
+8 IF (Y="")
SET Y=3
+9 IF ($EXTRACT(Y)="?")!(+Y<1)!(+Y>5)
WRITE !!,*7,"Enter only '1' through '3'."
GOTO TYPE
+10 SET ACHSRPT=+Y
DEV ;
+1 SET %=$$PB^ACHS
+2 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
DO K
QUIT
+3 IF %="B"
DO VIEWR^XBLM("START^ACHSVND")
DO EN^XBVK("VALM")
DO K
QUIT
+4 SET %ZIS="OPQ"
+5 DO ^%ZIS
+6 IF POP
DO HOME^%ZIS
GOTO K
+7 IF '$DATA(IO("Q"))
GOTO START
+8 KILL IO("Q")
+9 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+10 SET ZTRTN="START^ACHSVND"
SET ZTDESC="CHS VENDOR LISTING"
+11 FOR %="ACHSCFY"
SET ZTSAVE(%)=""
+12 DO ^%ZTLOAD
+13 IF '$DATA(ZTSK)
GOTO DEV
+14 KILL ZTSK
+15 GOTO K
+16 ;
START ;EP - TaskMan.
+1 SET (DA,ACHSRCT)=0
SET ACHSNAME=""
+2 DO BRPT^ACHSFU
+3 DO HDR
L1 ;
+1 SET ACHSNAME=$ORDER(^AUTTVNDR("B",ACHSNAME))
+2 IF ACHSNAME=""
GOTO END
L2 ;
+1 SET DA=$ORDER(^AUTTVNDR("B",ACHSNAME,DA))
+2 IF DA=""
GOTO L1
+3 ;ACHS*3.1*12 ADD A SORT BY STATUS NXT. 2 LINES
+4 IF ACHSRPT=1
IF $PIECE(^AUTTVNDR(DA,0),U,5)>1
GOTO L1
+5 IF ACHSRPT=2
IF $PIECE(^AUTTVNDR(DA,0),U,5)=""
GOTO L1
+6 SET ACHS11=$SELECT($DATA(^AUTTVNDR(DA,11)):^(11),1:"")
SET ACHS13=$SELECT($DATA(^AUTTVNDR(DA,13)):^(13),1:"")
+7 WRITE !,$PIECE(ACHS11,U),?15,$EXTRACT($PIECE(^AUTTVNDR(DA,0),U),1,30),?50,$EXTRACT($PIECE(ACHS13,U),1,30),!,$EXTRACT($PIECE(ACHS13,U,2),1,15),?18,$SELECT($PIECE(ACHS13,U,3)]"":$PIECE(^DIC(5,$PIECE(ACHS13,U,3),0),U,2),1:""),?24,$PIECE(ACHS13,U,4
)
+8 IF $DATA(^ACHSVPMT(DUZ(2),1,DA,1,ACHSCFY,0))
WRITE ?35,$$FMTE^XLFDT($PIECE(^(0),U,3)),?52
SET X=$PIECE(^ACHSVPMT(DUZ(2),1,DA,1,ACHSCFY,0),U,2)
DO FMT^ACHS
+9 WRITE ?66,$PIECE(ACHS11,U,9),!,$$REPEAT^XLFSTR("-",80)
+10 SET ACHSRCT=ACHSRCT+1
+11 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO K
DO HDR
+12 GOTO L2
+13 ;
END ;
+1 WRITE !!,"NUMBER OF VENDORS = ",ACHSRCT
+2 DO RTRN^ACHS
+3 WRITE @IOF
K ;
+1 KILL DA
+2 DO ERPT^ACHS
DO EN^XBVK("ACHS")
+3 IF '$DATA(ZTQUEUED)
DO ^ACHSVAR
DO HOME^%ZIS
+4 QUIT
+5 ;
HDR ;
+1 SET ACHSPG=ACHSPG+1
+2 ;ITSC/SET/JVK ACHS*3.1*12 ADD NXT LINE AND MODIFIED FOLLWING
+3 SET ACHSRTNM=$SELECT(ACHSRPT=1:" ACTIVE ",ACHSRPT=2:" INACTIVE ",ACHSRPT=3:" COMPLETE ")
+4 ;W @IOF,!,$$C^XBFUNC("CONTRACT HEALTH MANAGEMENT SYSTEM",80),!?24,"P R O V I D E R L I S T I N G",?71,"Page",$J(ACHSPG,3),!,ACHSLOC,!,ACHSTIME,!!,$$REPEAT^XLFSTR("*",80),!
+5 WRITE @IOF,!,$$C^XBFUNC("CONTRACT HEALTH MANAGEMENT SYSTEM",80),!?24,ACHSRTNM_"PROVIDER LISTING",?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHSLOC,!,ACHSTIME,!!,$$REPEAT^XLFSTR("*",80),!
+6 WRITE "EIN NUMBER",?15,"PROVIDER",?50,"ADDRESS",!,"CITY",?18,"STATE",?24,"ZIP",?35,"LAST PAY DATE",?52,"YTD PAID",?66,"PHONE #",!,$$REPEAT^XLFSTR("*",80),!
+7 QUIT
