- 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 Feb 18, 2025@23:12:52 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
