- 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
