FHADR8.m

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 ---FHADR8   1307     printed  Apr 09, 2024@20:53:28                                                                                                                                                                                                      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