Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FSCFORMT

FSCFORMT.m

Go to the documentation of this file.
FSCFORMT ;SLC/STAFF-NOIS Format Text ;4/22/94  10:50
 ;;1.1;NOIS;;Sep 06, 1998
 ;
TEXT(CALLNUM,TEXT,LIMIT) ; from FSCFORMB
 K TEXT I '$G(LIMIT) S LIMIT=9
 N CHECK,CNT,DCNT,DCNT1,DONE,FIELD,FILL,LINE,LOWCNT,NCNT,NCNT1,RCNT,RCNT1 K CHECK,FILL
 S (CNT,DCNT,DCNT1,DONE,NCNT1,RCNT,RCNT1)=0,NCNT=$P($G(^FSCD("CALL",CALLNUM,120)),U,6)-1,(CHECK("D"),CHECK("N"),CHECK("R"))=""
 F  D  Q:DONE
 .I $D(CHECK("D")) S DCNT=$O(^FSCD("CALL",CALLNUM,30,DCNT)),LINE=$G(^(+DCNT,0)) D  I $$DONE(CNT,.CHECK) S DONE=1 Q
 ..I 'DCNT K CHECK("D") Q
 ..I LINE=" "!'$L(LINE) Q
 ..S CNT=CNT+1,TEXT("D",CNT)=LINE,DCNT1=DCNT1+1
 .I $D(CHECK("N")) S NCNT=$O(^FSCD("CALL",CALLNUM,50,NCNT)),LINE=$G(^(+NCNT,0)) D  I $$DONE(CNT,.CHECK) S DONE=1 Q
 ..I 'NCNT K CHECK("N") Q
 ..I LINE=" "!'$L(LINE) Q
 ..S CNT=CNT+1,TEXT("N",CNT)=LINE,NCNT1=NCNT+1
 .I $D(CHECK("R")) S RCNT=$O(^FSCD("CALL",CALLNUM,80,RCNT)),LINE=$G(^(+RCNT,0)) D  I $$DONE(CNT,.CHECK) S DONE=1 Q
 ..I 'RCNT K CHECK("R") Q
 ..I LINE=" "!'$L(LINE) Q
 ..S CNT=CNT+1,TEXT("R",CNT)=LINE,RCNT1=RCNT1+1
 S TEXT("D")=$S('$O(^FSCD("CALL",CALLNUM,30,0)):"(no entry)",$O(^(DCNT1)):"(partial entry)",1:"")
 S TEXT("N")=$S('$O(^FSCD("CALL",CALLNUM,50,0)):"(no entry)",$O(^(NCNT1)):"(partial entry)",1:"")
 S TEXT("R")=$S('$O(^FSCD("CALL",CALLNUM,80,0)):"(no entry)",$O(^(RCNT1)):"(partial entry)",1:"")
 I CNT'<LIMIT Q
 S (FILL(+DCNT1,"D"),FILL(+NCNT1,"N"),FILL(+RCNT1,"R"))="",DONE=0
 F  D  Q:DONE
 .S LOWCNT=+$O(FILL("")),FIELD=$O(FILL(LOWCNT,""))
 .K FILL(LOWCNT,FIELD)
 .S FILL(LOWCNT+1,FIELD)=""
 .S CNT=CNT+1
 .S TEXT(FIELD,CNT)=""
 .I CNT'<LIMIT S DONE=1 Q
 Q
 ;
DONE(CNT,CHECK) ; $$(text count,check array) -> 1 if count>LIMIT or no text remaing else 0
 I CNT'<LIMIT Q 1
 I '$D(CHECK) Q 1
 Q 0