ACGSEDIT ;IHS/OIRM/DSD/THL - EDIT CONTRACT/CONTRACT ACTION; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;ROUTINE WHICH IS CALLED TO EDIT CONTRACT/CONTRACT ACTION
EN K ACGNEW
F D EDIT Q:$D(ACGQUIT)!$D(ACGOUT)
EXIT K ACG,ACGN,ACGJ,ACGI,ACGQUIT,ACGTOT,ACGFLDS,ACGFLDSS,ACGCNO,ACGRDA,ACGOUT,ACGXX
Q
EDIT D VND^ACGSTAR1:'$D(ACGOUT)
Q:$D(ACGQUIT)!$D(ACGOUT)!'$D(ACG5DA)
F D EDIT1 Q:$D(ACGQUIT)
K ACGQUIT
Q
EDIT1 ;EP;TO SELECT CONTRACT OR MODIFICATION TO EDIT
Q:'$D(ACGCNO)
W !!?13,"CONTRACT/",!,"NO.",?5,"TYPE",?11,"MODIFICATION",?30,"AMOUNT",!,"---",?5,"----",?11,"--------------",?27,"------------ --------------------------------------"
S (ACG,ACGJ,ACGTOT)=0
F S ACG=$O(^ACGS("C",ACGCNO,ACG)) Q:'ACG I $D(^ACGS(ACG,0)),$D(^("DT")) S ACGDT=^("DT") D
.S ACGJ=ACGJ+1,ACGXX($P(ACGDT,U,2),ACGJ)=ACG
S ACG="",ACGI=0
F S ACG=$O(ACGXX(ACG)) Q:ACG="" D
.S ACGJ=0
.F S ACGJ=$O(ACGXX(ACG,ACGJ)) Q:'ACGJ S ACGI=ACGI+1,ACG(ACGI-1)=ACGXX(ACG,ACGJ)
K ACGXX
S ACGI=""
F S ACGI=$O(ACG(ACGI)) Q:ACGI="" D
.S ACGJ=ACGI
.S ACG=+ACG(ACGI)
.Q:'ACG
.S ACGN=+^ACGS(ACG,0)
.I ACGN'=ACGJ,"^6^15^17^"'[(U_+^ACGS(ACG,"DT")_U) D COUNT
.D WEC
.I ACGJ>1,ACGJ#20=0 D HOLD^ACGSMENU
I ACGJ<0 W !!,"NO CONTRACT ACTIONS ON FILE FOR THIS CONTRACT" S ACGQUIT="" D HOLD^ACGSMENU Q
W !?27,"------------",!?18,"TOTAL:",?27,$J($FN(ACGTOT,"P",0),12),!
I $D(ACGNEW) K ACGNEW Q
I ACGJ=0 S Y=0 D E1 S ACGQUIT="" Q
S DIR(0)="NO^0:"_ACGJ,DIR("A")="Which one"
D DIR^ACGSDIC
Q:$D(ACGQUIT)!(Y<0)
E1 Q:'$D(ACG(Y))
S ACGRDA=ACG(Y),(ACGFLDS,ACGFLDSS)=$P(^ACGTPA($P(^ACGS(ACGRDA,"DT"),U),0),U)
I '$D(ACGFY),'ACGFY S ACGFY=91
I $P(^ACGS(ACGRDA,0),U,4)'="" W *7,*7,!!,"THIS RECORD HAS ALREADY BEEN EXPORTED AND CANNOT BE EDITED" Q
I $D(ACGDELET) D Q
.I $P(^ACGS(ACGRDA,0),U,3)=ACGRDA W *7,*7,!!,"ORIGINAL CONTRACT ACTION CANNOT BE DELETED." Q
.S ACG=ACGRDA D WEC S DIR(0)="YO",DIR("A")="Sure you want to delete this modification",DIR("B")="NO" W ! D DIR^ACGSDIC Q:$D(ACGQUIT)!(+Y'=1) S DA=ACGRDA,DIK="^ACGS(" D ^DIK
D ^ACGSCS
Q
COUNT S ACG2=$P(^ACGS(ACG,"DT"),U,2),DIE="^ACGS(",DA=ACG,DR=".01////"_ACGJ S:$E(ACG2,$L(ACGJ),$L(ACG2))'=ACGJ ACG2=$E(ACG2,1,$L(ACG2)-$L(ACGJ))_ACGJ,DR=DR_";2////"_ACG2_";1099////"_DT D DIE^ACGSDIC
Q
WEC Q:'$D(^ACGS(ACG,"DT"))!'$D(^("DT1"))
S ACGDT=^ACGS(ACG,"DT"),ACGDT1=^("DT1")
W !,ACGJ,?6,$P(^ACGTPA(+ACGDT,0),U),?11,$S("^15^17^"'[(U_+ACGDT_U):$P(^ACGS(ACG,"DT"),U,2),1:$P(^ACGS(ACG,"SP"),U)),?27,$J($FN($P(ACGDT1,U,5),"P",0),12),?41,$S("^15^17^"'[(U_+ACGDT_U):$E($P(ACGDT1,U),1,38),1:"SMALL PURCHASE")
S ACGTOT=ACGTOT+$P(^ACGS(ACG,"DT1"),U,5)
;PATCH XX
Q
ACGSEDIT ;IHS/OIRM/DSD/THL - EDIT CONTRACT/CONTRACT ACTION; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;ROUTINE WHICH IS CALLED TO EDIT CONTRACT/CONTRACT ACTION
EN KILL ACGNEW
+1 FOR
DO EDIT
IF $DATA(ACGQUIT)!$DATA(ACGOUT)
QUIT
EXIT KILL ACG,ACGN,ACGJ,ACGI,ACGQUIT,ACGTOT,ACGFLDS,ACGFLDSS,ACGCNO,ACGRDA,ACGOUT,ACGXX
+1 QUIT
EDIT IF '$DATA(ACGOUT)
DO VND^ACGSTAR1
+1 IF $DATA(ACGQUIT)!$DATA(ACGOUT)!'$DATA(ACG5DA)
QUIT
+2 FOR
DO EDIT1
IF $DATA(ACGQUIT)
QUIT
+3 KILL ACGQUIT
+4 QUIT
EDIT1 ;EP;TO SELECT CONTRACT OR MODIFICATION TO EDIT
+1 IF '$DATA(ACGCNO)
QUIT
+2 WRITE !!?13,"CONTRACT/",!,"NO.",?5,"TYPE",?11,"MODIFICATION",?30,"AMOUNT",!,"---",?5,"----",?11,"--------------",?27,"------------ --------------------------------------"
+3 SET (ACG,ACGJ,ACGTOT)=0
+4 FOR
SET ACG=$ORDER(^ACGS("C",ACGCNO,ACG))
IF 'ACG
QUIT
IF $DATA(^ACGS(ACG,0))
IF $DATA(^("DT"))
SET ACGDT=^("DT")
Begin DoDot:1
+5 SET ACGJ=ACGJ+1
SET ACGXX($PIECE(ACGDT,U,2),ACGJ)=ACG
End DoDot:1
+6 SET ACG=""
SET ACGI=0
+7 FOR
SET ACG=$ORDER(ACGXX(ACG))
IF ACG=""
QUIT
Begin DoDot:1
+8 SET ACGJ=0
+9 FOR
SET ACGJ=$ORDER(ACGXX(ACG,ACGJ))
IF 'ACGJ
QUIT
SET ACGI=ACGI+1
SET ACG(ACGI-1)=ACGXX(ACG,ACGJ)
End DoDot:1
+10 KILL ACGXX
+11 SET ACGI=""
+12 FOR
SET ACGI=$ORDER(ACG(ACGI))
IF ACGI=""
QUIT
Begin DoDot:1
+13 SET ACGJ=ACGI
+14 SET ACG=+ACG(ACGI)
+15 IF 'ACG
QUIT
+16 SET ACGN=+^ACGS(ACG,0)
+17 IF ACGN'=ACGJ
IF "^6^15^17^"'[(U_+^ACGS(ACG,"DT")_U)
DO COUNT
+18 DO WEC
+19 IF ACGJ>1
IF ACGJ#20=0
DO HOLD^ACGSMENU
End DoDot:1
+20 IF ACGJ<0
WRITE !!,"NO CONTRACT ACTIONS ON FILE FOR THIS CONTRACT"
SET ACGQUIT=""
DO HOLD^ACGSMENU
QUIT
+21 WRITE !?27,"------------",!?18,"TOTAL:",?27,$JUSTIFY($FNUMBER(ACGTOT,"P",0),12),!
+22 IF $DATA(ACGNEW)
KILL ACGNEW
QUIT
+23 IF ACGJ=0
SET Y=0
DO E1
SET ACGQUIT=""
QUIT
+24 SET DIR(0)="NO^0:"_ACGJ
SET DIR("A")="Which one"
+25 DO DIR^ACGSDIC
+26 IF $DATA(ACGQUIT)!(Y<0)
QUIT
E1 IF '$DATA(ACG(Y))
QUIT
+1 SET ACGRDA=ACG(Y)
SET (ACGFLDS,ACGFLDSS)=$PIECE(^ACGTPA($PIECE(^ACGS(ACGRDA,"DT"),U),0),U)
+2 IF '$DATA(ACGFY)
IF 'ACGFY
SET ACGFY=91
+3 IF $PIECE(^ACGS(ACGRDA,0),U,4)'=""
WRITE *7,*7,!!,"THIS RECORD HAS ALREADY BEEN EXPORTED AND CANNOT BE EDITED"
QUIT
+4 IF $DATA(ACGDELET)
Begin DoDot:1
+5 IF $PIECE(^ACGS(ACGRDA,0),U,3)=ACGRDA
WRITE *7,*7,!!,"ORIGINAL CONTRACT ACTION CANNOT BE DELETED."
QUIT
+6 SET ACG=ACGRDA
DO WEC
SET DIR(0)="YO"
SET DIR("A")="Sure you want to delete this modification"
SET DIR("B")="NO"
WRITE !
DO DIR^ACGSDIC
IF $DATA(ACGQUIT)!(+Y'=1)
QUIT
SET DA=ACGRDA
SET DIK="^ACGS("
DO ^DIK
End DoDot:1
QUIT
+7 DO ^ACGSCS
+8 QUIT
COUNT SET ACG2=$PIECE(^ACGS(ACG,"DT"),U,2)
SET DIE="^ACGS("
SET DA=ACG
SET DR=".01////"_ACGJ
IF $EXTRACT(ACG2,$LENGTH(ACGJ),$LENGTH(ACG2))'=ACGJ
SET ACG2=$EXTRACT(ACG2,1,$LENGTH(ACG2)-$LENGTH(ACGJ))_ACGJ
SET DR=DR_";2////"_ACG2_";1099////"_DT
DO DIE^ACGSDIC
+1 QUIT
WEC IF '$DATA(^ACGS(ACG,"DT"))!'$DATA(^("DT1"))
QUIT
+1 SET ACGDT=^ACGS(ACG,"DT")
SET ACGDT1=^("DT1")
+2 WRITE !,ACGJ,?6,$PIECE(^ACGTPA(+ACGDT,0),U),?11,$SELECT("^15^17^"'[(U_+ACGDT_U):$PIECE(^ACGS(ACG,"DT"),U,2),1:$PIECE(^ACGS(ACG,"SP"),U)),?27,$JUSTIFY(...
... $FNUMBER($PIECE(ACGDT1,U,5),"P",0),12),?41,$SELECT("^15^17^"'[(U_+ACGDT_U):$EXTRACT($PIECE(ACGDT1,U),1,38),1:"SMALL PURCHASE")
+3 SET ACGTOT=ACGTOT+$PIECE(^ACGS(ACG,"DT1"),U,5)
+4 ;PATCH XX
+5 QUIT
