ACHSVDV2 ; IHS/ITSC/TPF/PMF - YTD PAID VENDOR INFO BY FY ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**15**;JUN 11, 2001
;ACHS*3.1*15;IHS.OIT.FCJ MODIFIED FORMAT FOR DISPLAYING RATE AND CONTRACT NUMBER NEW LENGTH
;
N ACHSIEN
S ACHSIEN=$O(^ACHSVPMT(DUZ(2),1,"B",ACHSPROV,0))
I 'ACHSIEN W !!,"None on file." Q
I '$D(^ACHSVPMT(DUZ(2),1,ACHSIEN,1,0)) W !!,"None on file." Q
;
W !!,"FISCAL YEAR",?16,"A M O U N T",?30,"LAST PMT DATE",!!
F ACHS=0:0 S ACHS=$O(^ACHSVPMT(DUZ(2),1,ACHSIEN,1,ACHS)) Q:'ACHS W ?2,ACHS,?14,"$",$J($FN($P(^(ACHS,0),U,2),",",2),12),?30,$$FMTE^XLFDT($P(^(0),U,3)),!
Q
;
AGRDSP ;EP
G:'$D(^AUTTVNDR(ACHSPROV,18,"AGR",ACHSAGTP)) AGRNEW
D HDR
S R="",ACHSI=0
K ACHSAGRL
AGRDSP1 ;
S R=$O(^AUTTVNDR(ACHSPROV,18,"AGR",ACHSAGTP,R))
G AGRDSPZ:+R=0
A2A ;
S ACHSI=ACHSI+1,ACHSAGRL(ACHSI)=R
;ACHS*3.1*15 IHS.OIT.FCJ REWROTE DISPLAY OF RATE #
;W !,$J(ACHSI,2),?3,ACHSAGTP,?14,$E($P(^AUTTVNDR(ACHSPROV,18,R,0),U,1),1,2),$S(ACHSAGTP="BPA":"-A-",ACHSAGTP="PA":"-PA-",ACHSAGTP="RQ":"-R-",1:"")
W !,$J(ACHSI,2),?3,ACHSAGTP
I $L($P(^AUTTVNDR(ACHSPROV,18,R,0),U,1))>6 W ?8,$P(^(0),U) G A2C
E W ?8,$E($P(^AUTTVNDR(ACHSPROV,18,R,0),U,1),1,2),$S(ACHSAGTP="BPA":"-A-",ACHSAGTP="PA":"-PA-",ACHSAGTP="RQ":"-R-",1:"")
S X=$E($P(^AUTTVNDR(ACHSPROV,18,R,0),U,1),3,6)
I ACHSAGTP="PA" W $E(X,2,4) G A2C
W $E(X,1,4)
A2C ;
W ?27,$$MDY($P(^AUTTVNDR(ACHSPROV,18,R,0),U,8)),?36,$$MDY($P(^AUTTVNDR(ACHSPROV,18,R,0),U,9))
S X=$P(^AUTTVNDR(ACHSPROV,18,R,0),U,4)
I X="",($P(^AUTTVNDR(ACHSPROV,18,R,0),U,2)="") G A2D
S Y=$S(X="Y":"YES",X="N":" NO",1:" ")
I Y=" ",($P(^AUTTVNDR(ACHSPROV,18,R,0),U,2)="") G A2D
S Y=Y_" INP: "
S:$P(^AUTTVNDR(ACHSPROV,18,R,0),U,2)'="" Y=Y_$P(^(0),U,2)
W ?45,Y,!
A2D ;
S X=$P(^AUTTVNDR(ACHSPROV,18,R,0),U,5)
I X="",($P(^AUTTVNDR(ACHSPROV,18,R,0),U,3)="") G A2E
S Y=$S(X="Y":"YES",X="N":" NO",1:" ")
I Y=" ",($P(^AUTTVNDR(ACHSPROV,18,R,0),U,3)="") G A2E
S Y=Y_" OUT: "
S:$P(^AUTTVNDR(ACHSPROV,18,R,0),U,3)'="" Y=Y_$P(^(0),U,3)
W ?45,Y,!
A2E ;
W:$P(^AUTTVNDR(ACHSPROV,18,R,0),U,7)'="" ?49,"PRO: ",$P(^(0),U,7),!
G AGRDSP1
;
AGRDSPZ ;
Q:$D(ACHSRQFL)!$D(ACHSPAFL)!$D(ACHSBPFL)
AGRSEL ;
S DA=""
S Y=$$DIR^XBDIR("NO^1:"_ACHSI,"Enter # to Edit","","","","",2)
Q:$D(DUOUT)!$D(DTOUT)
I Y="" G AGRNEW
S DA=ACHSAGRL(+Y)
Q
;
AGRNEW ;ADD NEW AGREEMENT INFORMATION HERE
Q:'$D(^XUSEC("ACHSZMGR",DUZ))
S Y=$$DIR^XBDIR("Y","Want to enter a new Vendor "_$S(ACHSAGTP="RQ":"RATE QUOTATION",ACHSAGTP="PA":"PROVIDER AGREEMENT",ACHSAGTP="BPA":"BLANKET PURCHASE AGREEMENT",1:" "),"N","","","",2)
Q:$D(DTOUT)!$D(DUOUT)
I 'Y S DA="" W @IOF Q
S:'$D(^AUTTVNDR(ACHSPROV,18,0)) ^AUTTVNDR(ACHSPROV,18,0)=$$ZEROTH^ACHS(9999999.11,1801)
S DIC="^AUTTVNDR("_ACHSPROV_",18,",DIC(0)="QAZEML",DA(1)=ACHSPROV,DIC("W")="W "" "",$P(^(0),U,10)"
D ^DIC
Q:+Y<1
S DA(1)=ACHSPROV,DA=+Y
W !
K DIE,DR
S DIE("NO^")="",DIE=DIC,DR=".11///^S X=ACHSAGTP;.02;.04;.03;.05;.07;.06;.08;.09"
D ^DIE
K DIE
D AGRDSP
Q
;
HDR ;
W !!," #",?3,"Type",?14,"Number",?27,"Eff-Date",?36,"Exp-Date",?45,"MCR",?49,"Description",!?3,"----",?8,"------------------",?27,"--------",?36,"--------",?45,"---",?49,"----------------------------"
Q
;
MDY(X) ;
Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
;
ACHSVDV2 ; IHS/ITSC/TPF/PMF - YTD PAID VENDOR INFO BY FY ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**15**;JUN 11, 2001
+2 ;ACHS*3.1*15;IHS.OIT.FCJ MODIFIED FORMAT FOR DISPLAYING RATE AND CONTRACT NUMBER NEW LENGTH
+3 ;
+4 NEW ACHSIEN
+5 SET ACHSIEN=$ORDER(^ACHSVPMT(DUZ(2),1,"B",ACHSPROV,0))
+6 IF 'ACHSIEN
WRITE !!,"None on file."
QUIT
+7 IF '$DATA(^ACHSVPMT(DUZ(2),1,ACHSIEN,1,0))
WRITE !!,"None on file."
QUIT
+8 ;
+9 WRITE !!,"FISCAL YEAR",?16,"A M O U N T",?30,"LAST PMT DATE",!!
+10 FOR ACHS=0:0
SET ACHS=$ORDER(^ACHSVPMT(DUZ(2),1,ACHSIEN,1,ACHS))
IF 'ACHS
QUIT
WRITE ?2,ACHS,?14,"$",$JUSTIFY($FNUMBER($PIECE(^(ACHS,0),U,2),",",2),12),?30,$$FMTE^XLFDT($PIECE(^(0),U,3)),!
+11 QUIT
+12 ;
AGRDSP ;EP
+1 IF '$DATA(^AUTTVNDR(ACHSPROV,18,"AGR",ACHSAGTP))
GOTO AGRNEW
+2 DO HDR
+3 SET R=""
SET ACHSI=0
+4 KILL ACHSAGRL
AGRDSP1 ;
+1 SET R=$ORDER(^AUTTVNDR(ACHSPROV,18,"AGR",ACHSAGTP,R))
+2 IF +R=0
GOTO AGRDSPZ
A2A ;
+1 SET ACHSI=ACHSI+1
SET ACHSAGRL(ACHSI)=R
+2 ;ACHS*3.1*15 IHS.OIT.FCJ REWROTE DISPLAY OF RATE #
+3 ;W !,$J(ACHSI,2),?3,ACHSAGTP,?14,$E($P(^AUTTVNDR(ACHSPROV,18,R,0),U,1),1,2),$S(ACHSAGTP="BPA":"-A-",ACHSAGTP="PA":"-PA-",ACHSAGTP="RQ":"-R-",1:"")
+4 WRITE !,$JUSTIFY(ACHSI,2),?3,ACHSAGTP
+5 IF $LENGTH($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,1))>6
WRITE ?8,$PIECE(^(0),U)
GOTO A2C
+6 IF '$TEST
WRITE ?8,$EXTRACT($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,1),1,2),$SELECT(ACHSAGTP="BPA":"-A-",ACHSAGTP="PA":"-PA-",ACHSAGTP="RQ":"-R-",1:"")
+7 SET X=$EXTRACT($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,1),3,6)
+8 IF ACHSAGTP="PA"
WRITE $EXTRACT(X,2,4)
GOTO A2C
+9 WRITE $EXTRACT(X,1,4)
A2C ;
+1 WRITE ?27,$$MDY($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,8)),?36,$$MDY($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,9))
+2 SET X=$PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,4)
+3 IF X=""
IF ($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,2)="")
GOTO A2D
+4 SET Y=$SELECT(X="Y":"YES",X="N":" NO",1:" ")
+5 IF Y=" "
IF ($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,2)="")
GOTO A2D
+6 SET Y=Y_" INP: "
+7 IF $PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,2)'=""
SET Y=Y_$PIECE(^(0),U,2)
+8 WRITE ?45,Y,!
A2D ;
+1 SET X=$PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,5)
+2 IF X=""
IF ($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,3)="")
GOTO A2E
+3 SET Y=$SELECT(X="Y":"YES",X="N":" NO",1:" ")
+4 IF Y=" "
IF ($PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,3)="")
GOTO A2E
+5 SET Y=Y_" OUT: "
+6 IF $PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,3)'=""
SET Y=Y_$PIECE(^(0),U,3)
+7 WRITE ?45,Y,!
A2E ;
+1 IF $PIECE(^AUTTVNDR(ACHSPROV,18,R,0),U,7)'=""
WRITE ?49,"PRO: ",$PIECE(^(0),U,7),!
+2 GOTO AGRDSP1
+3 ;
AGRDSPZ ;
+1 IF $DATA(ACHSRQFL)!$DATA(ACHSPAFL)!$DATA(ACHSBPFL)
QUIT
AGRSEL ;
+1 SET DA=""
+2 SET Y=$$DIR^XBDIR("NO^1:"_ACHSI,"Enter # to Edit","","","","",2)
+3 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+4 IF Y=""
GOTO AGRNEW
+5 SET DA=ACHSAGRL(+Y)
+6 QUIT
+7 ;
AGRNEW ;ADD NEW AGREEMENT INFORMATION HERE
+1 IF '$DATA(^XUSEC("ACHSZMGR",DUZ))
QUIT
+2 SET Y=$$DIR^XBDIR("Y","Want to enter a new Vendor "_$SELECT(ACHSAGTP="RQ":"RATE QUOTATION",ACHSAGTP="PA":"PROVIDER AGREEMENT",ACHSAGTP="BPA":"BLANKET PURCHASE AGREEMENT",1:" "),"N","","","",2)
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+4 IF 'Y
SET DA=""
WRITE @IOF
QUIT
+5 IF '$DATA(^AUTTVNDR(ACHSPROV,18,0))
SET ^AUTTVNDR(ACHSPROV,18,0)=$$ZEROTH^ACHS(9999999.11,1801)
+6 SET DIC="^AUTTVNDR("_ACHSPROV_",18,"
SET DIC(0)="QAZEML"
SET DA(1)=ACHSPROV
SET DIC("W")="W "" "",$P(^(0),U,10)"
+7 DO ^DIC
+8 IF +Y<1
QUIT
+9 SET DA(1)=ACHSPROV
SET DA=+Y
+10 WRITE !
+11 KILL DIE,DR
+12 SET DIE("NO^")=""
SET DIE=DIC
SET DR=".11///^S X=ACHSAGTP;.02;.04;.03;.05;.07;.06;.08;.09"
+13 DO ^DIE
+14 KILL DIE
+15 DO AGRDSP
+16 QUIT
+17 ;
HDR ;
+1 WRITE !!," #",?3,"Type",?14,"Number",?27,"Eff-Date",?36,"Exp-Date",?45,"MCR",?49,"Description",!?3,"----",?8,"------------------",?27,"--------",?36,"--------",?45,"---",?49,"----------------------------"
+2 QUIT
+3 ;
MDY(X) ;
+1 QUIT $EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+2 ;
