FHADR8 ; HISC/NCA/FAI- Dietetic Costs ;11/17/04 09:20
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Cost Diem
K COST,N S COST="",NFLG=0 D QR^FHADR1 G:'PRE KIL
S FHYR=$E(PRE,1,3) D Q2^FHADRPT K FHYR G:'SDT!('EDT) KIL
S Z1=$P($G(^FH(117.3,PRE,"COST",0)),"^",3),Z2=$P($G(^FH(117.3,PRE,"COST",+Z1,0)),"^",1)
I Z2="" S NFLG=1
E1 K DIR S DIR(0)="117.332,.01",DIR("A")="Enter Cumulative Total on the 830 Report of Costs" S:Z2 DIR("B")=Z2
D ^DIR I X="@" W *7," REQUIRED FIELD!" G E1
G:$D(DIRUT)!($D(DIROUT)) KIL
S:X["$" X=$P(X,"$",2) S FHX=+X
I Z1,Z2'=+FHX S $P(^FH(117.3,PRE,"COST",+Z1,0),"^",1)=+FHX K:$D(^FH(117.3,PRE,"COST","B",+Z2,+Z1)) ^FH(117.3,PRE,"COST","B",+Z2,+Z1) S ^FH(117.3,PRE,"COST","B",+FHX,+Z1)=""
I 'NFLG G EDIT
I '$D(^FH(117.3,PRE,"COST",0)) S ^FH(117.3,PRE,"COST",0)="^117.332^^"
K DIC,DD,DO S DIC="^FH(117.3,PRE,""COST"",",DIC(0)="L",DLAYGO=117.3,DA(1)=PRE
S DA=$P($G(^FH(117.3,PRE,"COST",0)),"^",3)+1 I $D(^FH(117.3,PRE,"COST",0)) S $P(^FH(117.3,PRE,"COST",0),"^",3)=DA
S X=+FHX,DINUM=DA D FILE^DICN K DA,DIC,DLAYGO,DINUM S Z1=+Y
EDIT K DIC,DIE S DA(0)=PRE,DA=+Z1,DIE="^FH(117.3,"_DA(0)_",""COST"","
S DR="1:7"
L +^FH(117.3,PRE,"COST",0):0 I '$T W !?5,"Another user is editing this entry." G KIL
D ^DIE L -^FH(117.3,PRE,"COST",0)
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHADR8 1307 printed Dec 13, 2024@01:46:36 Page 2
FHADR8 ; HISC/NCA/FAI- Dietetic Costs ;11/17/04 09:20
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Cost Diem
+1 KILL COST,N
SET COST=""
SET NFLG=0
DO QR^FHADR1
if 'PRE
GOTO KIL
+2 SET FHYR=$EXTRACT(PRE,1,3)
DO Q2^FHADRPT
KILL FHYR
if 'SDT!('EDT)
GOTO KIL
+3 SET Z1=$PIECE($GET(^FH(117.3,PRE,"COST",0)),"^",3)
SET Z2=$PIECE($GET(^FH(117.3,PRE,"COST",+Z1,0)),"^",1)
+4 IF Z2=""
SET NFLG=1
E1 KILL DIR
SET DIR(0)="117.332,.01"
SET DIR("A")="Enter Cumulative Total on the 830 Report of Costs"
if Z2
SET DIR("B")=Z2
+1 DO ^DIR
IF X="@"
WRITE *7," REQUIRED FIELD!"
GOTO E1
+2 if $DATA(DIRUT)!($DATA(DIROUT))
GOTO KIL
+3 if X["$"
SET X=$PIECE(X,"$",2)
SET FHX=+X
+4 IF Z1
IF Z2'=+FHX
SET $PIECE(^FH(117.3,PRE,"COST",+Z1,0),"^",1)=+FHX
if $DATA(^FH(117.3,PRE,"COST","B",+Z2,+Z1))
KILL ^FH(117.3,PRE,"COST","B",+Z2,+Z1)
SET ^FH(117.3,PRE,"COST","B",+FHX,+Z1)=""
+5 IF 'NFLG
GOTO EDIT
+6 IF '$DATA(^FH(117.3,PRE,"COST",0))
SET ^FH(117.3,PRE,"COST",0)="^117.332^^"
+7 KILL DIC,DD,DO
SET DIC="^FH(117.3,PRE,""COST"","
SET DIC(0)="L"
SET DLAYGO=117.3
SET DA(1)=PRE
+8 SET DA=$PIECE($GET(^FH(117.3,PRE,"COST",0)),"^",3)+1
IF $DATA(^FH(117.3,PRE,"COST",0))
SET $PIECE(^FH(117.3,PRE,"COST",0),"^",3)=DA
+9 SET X=+FHX
SET DINUM=DA
DO FILE^DICN
KILL DA,DIC,DLAYGO,DINUM
SET Z1=+Y
EDIT KILL DIC,DIE
SET DA(0)=PRE
SET DA=+Z1
SET DIE="^FH(117.3,"_DA(0)_",""COST"","
+1 SET DR="1:7"
+2 LOCK +^FH(117.3,PRE,"COST",0):0
IF '$TEST
WRITE !?5,"Another user is editing this entry."
GOTO KIL
+3 DO ^DIE
LOCK -^FH(117.3,PRE,"COST",0)
KIL GOTO KILL^XUSCLEAN
