- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCFORMT 1757 printed Feb 18, 2025@23:44:19 Page 2
- FSCFORMT ;SLC/STAFF-NOIS Format Text ;4/22/94 10:50
- +1 ;;1.1;NOIS;;Sep 06, 1998
- +2 ;
- TEXT(CALLNUM,TEXT,LIMIT) ; from FSCFORMB
- +1 KILL TEXT
- IF '$GET(LIMIT)
- SET LIMIT=9
- +2 NEW CHECK,CNT,DCNT,DCNT1,DONE,FIELD,FILL,LINE,LOWCNT,NCNT,NCNT1,RCNT,RCNT1
- KILL CHECK,FILL
- +3 SET (CNT,DCNT,DCNT1,DONE,NCNT1,RCNT,RCNT1)=0
- SET NCNT=$PIECE($GET(^FSCD("CALL",CALLNUM,120)),U,6)-1
- SET (CHECK("D"),CHECK("N"),CHECK("R"))=""
- +4 FOR
- Begin DoDot:1
- +5 IF $DATA(CHECK("D"))
- SET DCNT=$ORDER(^FSCD("CALL",CALLNUM,30,DCNT))
- SET LINE=$GET(^(+DCNT,0))
- Begin DoDot:2
- +6 IF 'DCNT
- KILL CHECK("D")
- QUIT
- +7 IF LINE=" "!'$LENGTH(LINE)
- QUIT
- +8 SET CNT=CNT+1
- SET TEXT("D",CNT)=LINE
- SET DCNT1=DCNT1+1
- End DoDot:2
- IF $$DONE(CNT,.CHECK)
- SET DONE=1
- QUIT
- +9 IF $DATA(CHECK("N"))
- SET NCNT=$ORDER(^FSCD("CALL",CALLNUM,50,NCNT))
- SET LINE=$GET(^(+NCNT,0))
- Begin DoDot:2
- +10 IF 'NCNT
- KILL CHECK("N")
- QUIT
- +11 IF LINE=" "!'$LENGTH(LINE)
- QUIT
- +12 SET CNT=CNT+1
- SET TEXT("N",CNT)=LINE
- SET NCNT1=NCNT+1
- End DoDot:2
- IF $$DONE(CNT,.CHECK)
- SET DONE=1
- QUIT
- +13 IF $DATA(CHECK("R"))
- SET RCNT=$ORDER(^FSCD("CALL",CALLNUM,80,RCNT))
- SET LINE=$GET(^(+RCNT,0))
- Begin DoDot:2
- +14 IF 'RCNT
- KILL CHECK("R")
- QUIT
- +15 IF LINE=" "!'$LENGTH(LINE)
- QUIT
- +16 SET CNT=CNT+1
- SET TEXT("R",CNT)=LINE
- SET RCNT1=RCNT1+1
- End DoDot:2
- IF $$DONE(CNT,.CHECK)
- SET DONE=1
- QUIT
- End DoDot:1
- if DONE
- QUIT
- +17 SET TEXT("D")=$SELECT('$ORDER(^FSCD("CALL",CALLNUM,30,0)):"(no entry)",$ORDER(^(DCNT1)):"(partial entry)",1:"")
- +18 SET TEXT("N")=$SELECT('$ORDER(^FSCD("CALL",CALLNUM,50,0)):"(no entry)",$ORDER(^(NCNT1)):"(partial entry)",1:"")
- +19 SET TEXT("R")=$SELECT('$ORDER(^FSCD("CALL",CALLNUM,80,0)):"(no entry)",$ORDER(^(RCNT1)):"(partial entry)",1:"")
- +20 IF CNT'<LIMIT
- QUIT
- +21 SET (FILL(+DCNT1,"D"),FILL(+NCNT1,"N"),FILL(+RCNT1,"R"))=""
- SET DONE=0
- +22 FOR
- Begin DoDot:1
- +23 SET LOWCNT=+$ORDER(FILL(""))
- SET FIELD=$ORDER(FILL(LOWCNT,""))
- +24 KILL FILL(LOWCNT,FIELD)
- +25 SET FILL(LOWCNT+1,FIELD)=""
- +26 SET CNT=CNT+1
- +27 SET TEXT(FIELD,CNT)=""
- +28 IF CNT'<LIMIT
- SET DONE=1
- QUIT
- End DoDot:1
- if DONE
- QUIT
- +29 QUIT
- +30 ;
- DONE(CNT,CHECK) ; $$(text count,check array) -> 1 if count>LIMIT or no text remaing else 0
- +1 IF CNT'<LIMIT
- QUIT 1
- +2 IF '$DATA(CHECK)
- QUIT 1
- +3 QUIT 0
