source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCFORMT.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1FSCFORMT ;SLC/STAFF-NOIS Format Text ;4/22/94 10:50
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4TEXT(CALLNUM,TEXT,LIMIT) ; from FSCFORMB
5 K TEXT I '$G(LIMIT) S LIMIT=9
6 N CHECK,CNT,DCNT,DCNT1,DONE,FIELD,FILL,LINE,LOWCNT,NCNT,NCNT1,RCNT,RCNT1 K CHECK,FILL
7 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"))=""
8 F D Q:DONE
9 .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
10 ..I 'DCNT K CHECK("D") Q
11 ..I LINE=" "!'$L(LINE) Q
12 ..S CNT=CNT+1,TEXT("D",CNT)=LINE,DCNT1=DCNT1+1
13 .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
14 ..I 'NCNT K CHECK("N") Q
15 ..I LINE=" "!'$L(LINE) Q
16 ..S CNT=CNT+1,TEXT("N",CNT)=LINE,NCNT1=NCNT+1
17 .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
18 ..I 'RCNT K CHECK("R") Q
19 ..I LINE=" "!'$L(LINE) Q
20 ..S CNT=CNT+1,TEXT("R",CNT)=LINE,RCNT1=RCNT1+1
21 S TEXT("D")=$S('$O(^FSCD("CALL",CALLNUM,30,0)):"(no entry)",$O(^(DCNT1)):"(partial entry)",1:"")
22 S TEXT("N")=$S('$O(^FSCD("CALL",CALLNUM,50,0)):"(no entry)",$O(^(NCNT1)):"(partial entry)",1:"")
23 S TEXT("R")=$S('$O(^FSCD("CALL",CALLNUM,80,0)):"(no entry)",$O(^(RCNT1)):"(partial entry)",1:"")
24 I CNT'<LIMIT Q
25 S (FILL(+DCNT1,"D"),FILL(+NCNT1,"N"),FILL(+RCNT1,"R"))="",DONE=0
26 F D Q:DONE
27 .S LOWCNT=+$O(FILL("")),FIELD=$O(FILL(LOWCNT,""))
28 .K FILL(LOWCNT,FIELD)
29 .S FILL(LOWCNT+1,FIELD)=""
30 .S CNT=CNT+1
31 .S TEXT(FIELD,CNT)=""
32 .I CNT'<LIMIT S DONE=1 Q
33 Q
34 ;
35DONE(CNT,CHECK) ; $$(text count,check array) -> 1 if count>LIMIT or no text remaing else 0
36 I CNT'<LIMIT Q 1
37 I '$D(CHECK) Q 1
38 Q 0
Note: See TracBrowser for help on using the repository browser.