FHADR3 ; HISC/NCA - Facility Workload ;11/3/94 15:37
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Outpatients Visits
D QR^FHADR1 G:'PRE KIL
S OLD=$S($E(PRE,5)=1:$E(PRE,1,3)-1_"0400",1:$E(PRE,1,5)-1_"00")
S (Z,ZZZ)=""
K DIC,DIE W ! S DIE="^FH(117.3,",DA=PRE
S DR="21;23;S:X'="""" ZZZ=X"
L +^FH(117.3,PRE,0):0 I '$T W !?5,"Another user is editing the entry." G KIL
D ^DIE K DR
I ZZZ,$D(^FH(117.3,OLD,"CLIN",0)) D
.I '$D(^FH(117.3,PRE,"CLIN",0)) D
..S ^FH(117.3,PRE,"CLIN",0)="^117.325^^",NDE=$G(^FH(117.3,PRE,"CLIN",0)),NDE=$P(NDE,"^",4)
..F LP=0:0 S LP=$O(^FH(117.3,OLD,"CLIN",LP)) Q:LP<1 S Z1=$G(^(LP,0)) D
...I Z1'="",'$D(^FH(117.3,PRE,"CLIN",LP,0)) S ^(0)=$P(Z1,"^",1),^FH(117.3,PRE,"CLIN","B",$P(Z1,"^",1),LP)="",NDE=NDE+1,$P(^FH(117.3,PRE,"CLIN",0),"^",3,4)=LP_"^"_NDE Q
..Q
.Q
S DR="I 'ZZZ S Y="""";25"
S DR(2,117.325)=".01:1"
D ^DIE L -^FH(117.3,PRE,0) K DIE,DR
KIL G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHADR3 932 printed Dec 13, 2024@01:46:30 Page 2
FHADR3 ; HISC/NCA - Facility Workload ;11/3/94 15:37
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter/Edit Outpatients Visits
+1 DO QR^FHADR1
if 'PRE
GOTO KIL
+2 SET OLD=$SELECT($EXTRACT(PRE,5)=1:$EXTRACT(PRE,1,3)-1_"0400",1:$EXTRACT(PRE,1,5)-1_"00")
+3 SET (Z,ZZZ)=""
+4 KILL DIC,DIE
WRITE !
SET DIE="^FH(117.3,"
SET DA=PRE
+5 SET DR="21;23;S:X'="""" ZZZ=X"
+6 LOCK +^FH(117.3,PRE,0):0
IF '$TEST
WRITE !?5,"Another user is editing the entry."
GOTO KIL
+7 DO ^DIE
KILL DR
+8 IF ZZZ
IF $DATA(^FH(117.3,OLD,"CLIN",0))
Begin DoDot:1
+9 IF '$DATA(^FH(117.3,PRE,"CLIN",0))
Begin DoDot:2
+10 SET ^FH(117.3,PRE,"CLIN",0)="^117.325^^"
SET NDE=$GET(^FH(117.3,PRE,"CLIN",0))
SET NDE=$PIECE(NDE,"^",4)
+11 FOR LP=0:0
SET LP=$ORDER(^FH(117.3,OLD,"CLIN",LP))
if LP<1
QUIT
SET Z1=$GET(^(LP,0))
Begin DoDot:3
+12 IF Z1'=""
IF '$DATA(^FH(117.3,PRE,"CLIN",LP,0))
SET ^(0)=$PIECE(Z1,"^",1)
SET ^FH(117.3,PRE,"CLIN","B",$PIECE(Z1,"^",1),LP)=""
SET NDE=NDE+1
SET $PIECE(^FH(117.3,PRE,"CLIN",0),"^",3,4)=LP_"^"_NDE
QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 SET DR="I 'ZZZ S Y="""";25"
+16 SET DR(2,117.325)=".01:1"
+17 DO ^DIE
LOCK -^FH(117.3,PRE,0)
KILL DIE,DR
KIL GOTO KILL^XUSCLEAN
