FHCTF2.m

FHCTF2 ; HISC/REL - Tickler File Utilities ;4/26/91  12:12

 ;;5.5;DIETETICS;**20**;Jan 28, 2005;Build 7

FILE ; File Entry

 S %=$P(FHTF,"^",1) I $D(^FH(119,FHDUZ,"I")) G F1

 I '$D(^FH(119,FHDUZ)) S ^FH(119,FHDUZ,0)=FHDUZ,^FH(119,"B",FHDUZ,FHDUZ)=""

 S ^FH(119,FHDUZ,"I",0)="^119.01D^0^0"

 L +^FH(119,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) S FH3=$P(^FH(119,0),"^",3),FH4=$P(^FH(119,0),"^",4)

 I FHDUZ>FH3 S FH3=FHDUZ

 S FH4=FH4+1

 S $P(^FH(119,0),"^",3)=FH3,$P(^FH(119,0),"^",4)=FH4

 L -^FH(119,0)

F1 I $D(^FH(119,FHDUZ,"I",%)) S %=%+.000001 G F1

 S ^FH(119,FHDUZ,"I",%,0)=FHTF K %,FHTF Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHCTF2   596     printed  Apr 09, 2024@20:54:30                                                                                                                                                                                                       Page 2

FHCTF2    ; HISC/REL - Tickler File Utilities ;4/26/91  12:12

 +1       ;;5.5;DIETETICS;**20**;Jan 28, 2005;Build 7

FILE      ; File Entry

 +1        SET %=$PIECE(FHTF,"^",1)

           IF $DATA(^FH(119,FHDUZ,"I"))

               GOTO F1

 +2        IF '$DATA(^FH(119,FHDUZ))

               SET ^FH(119,FHDUZ,0)=FHDUZ

               SET ^FH(119,"B",FHDUZ,FHDUZ)=""

 +3        SET ^FH(119,FHDUZ,"I",0)="^119.01D^0^0"

 +4        LOCK +^FH(119,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)

           SET FH3=$PIECE(^FH(119,0),"^",3)

           SET FH4=$PIECE(^FH(119,0),"^",4)

 +5        IF FHDUZ>FH3

               SET FH3=FHDUZ

 +6        SET FH4=FH4+1

 +7        SET $PIECE(^FH(119,0),"^",3)=FH3

           SET $PIECE(^FH(119,0),"^",4)=FH4

 +8        LOCK -^FH(119,0)

F1         IF $DATA(^FH(119,FHDUZ,"I",%))

               SET %=%+.000001

               GOTO F1

 +1        SET ^FH(119,FHDUZ,"I",%,0)=FHTF

           KILL %,FHTF

           QUIT