- IBDFSS1 ;ALB/MAF - FORMS TRACKING SELECTED STATUS - JUL 6 1995
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- ;
- S IBDCNT1=IBDCNT1+1
- S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S X=""
- S IBDFDIV1(IBDFDV)=IBDCNT
- S X=$$SETSTR^VALM1(" ",X,1,3) D TMP1
- S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S IBDVAL=IBDFDV
- S IBDVAL1=$L(IBDVAL) S IBDVAL1=(80-IBDVAL1)/2 S IBDVAL1=IBDVAL1\1 S X=$$SETSTR^VALM1(" ",X,1,IBDVAL1)
- S X=$$SETSTR^VALM1(IBDVAL,X,IBDVAL1,25) D TMP1,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S X=$$SETSTR^VALM1(" ",X,1,3) D TMP1
- S IBDCNT1=IBDCNT1-1
- Q
- ;
- ;
- S IBDCNT1=IBDCNT1+1
- S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S X=""
- I $D(VAUTG) S IBCLIN(IBDFGR,IBDFCL)=IBDCNT
- I '$D(VAUTG) S IBCLIN(IBDFDV,IBDFCL)=IBDCNT
- S X=$$SETSTR^VALM1(" ",X,1,3) D TMP1
- S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S IBDVAL=IBDFCL
- S X=$$SETSTR^VALM1(IBDVAL,X,1,25) D TMP1,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- S IBDCNT1=IBDCNT1-1
- Q
- ;
- ;
- S IBDCNT1=IBDCNT1+1
- S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S X=""
- S IBDFGRP1(IBDFDV,IBDFGR)=IBDCNT
- S X=$$SETSTR^VALM1(" ",X,1,3) D TMP1
- S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- ;S IBDVAL=$P(^IBD(357.99,IBDFGR,0),"^",1)
- S IBDVAL=IBDFGR
- S IBDVAL1=$L(IBDVAL) S IBDVAL1=(80-IBDVAL1)/2 S IBDVAL1=IBDVAL1\1 S X=$$SETSTR^VALM1(" ",X,1,IBDVAL1)
- S X=$$SETSTR^VALM1(IBDVAL,X,IBDVAL1,25) D TMP1,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S X=$$SETSTR^VALM1(" ",X,1,3) D TMP1
- S IBDCNT1=IBDCNT1-1
- Q
- TMP1 ; -- Set up TMP Array
- S ^TMP("SSEL",$J,IBDCNT,0)=X,^TMP("SSEL",$J,"IDX",VALMCNT,IBDCNT1)=""
- S ^TMP("SELIDX",$J,IBDCNT1)=VALMCNT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFSS1 1864 printed Jan 18, 2025@03:54:37 Page 2
- IBDFSS1 ;ALB/MAF - FORMS TRACKING SELECTED STATUS - JUL 6 1995
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- +3 ;
- +1 SET IBDCNT1=IBDCNT1+1
- +2 SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +3 SET X=""
- +4 SET IBDFDIV1(IBDFDV)=IBDCNT
- +5 SET X=$$SETSTR^VALM1(" ",X,1,3)
- DO TMP1
- +6 SET X=""
- SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +7 SET IBDVAL=IBDFDV
- +8 SET IBDVAL1=$LENGTH(IBDVAL)
- SET IBDVAL1=(80-IBDVAL1)/2
- SET IBDVAL1=IBDVAL1\1
- SET X=$$SETSTR^VALM1(" ",X,1,IBDVAL1)
- +9 SET X=$$SETSTR^VALM1(IBDVAL,X,IBDVAL1,25)
- DO TMP1
- DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- +10 SET X=""
- SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +11 SET X=$$SETSTR^VALM1(" ",X,1,3)
- DO TMP1
- +12 SET IBDCNT1=IBDCNT1-1
- +13 QUIT
- +14 ;
- +15 ;
- +1 SET IBDCNT1=IBDCNT1+1
- +2 SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +3 SET X=""
- +4 IF $DATA(VAUTG)
- SET IBCLIN(IBDFGR,IBDFCL)=IBDCNT
- +5 IF '$DATA(VAUTG)
- SET IBCLIN(IBDFDV,IBDFCL)=IBDCNT
- +6 SET X=$$SETSTR^VALM1(" ",X,1,3)
- DO TMP1
- +7 SET X=""
- SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +8 SET IBDVAL=IBDFCL
- +9 SET X=$$SETSTR^VALM1(IBDVAL,X,1,25)
- DO TMP1
- DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- +10 SET IBDCNT1=IBDCNT1-1
- +11 QUIT
- +12 ;
- +13 ;
- +1 SET IBDCNT1=IBDCNT1+1
- +2 SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +3 SET X=""
- +4 SET IBDFGRP1(IBDFDV,IBDFGR)=IBDCNT
- +5 SET X=$$SETSTR^VALM1(" ",X,1,3)
- DO TMP1
- +6 SET X=""
- SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +7 ;S IBDVAL=$P(^IBD(357.99,IBDFGR,0),"^",1)
- +8 SET IBDVAL=IBDFGR
- +9 SET IBDVAL1=$LENGTH(IBDVAL)
- SET IBDVAL1=(80-IBDVAL1)/2
- SET IBDVAL1=IBDVAL1\1
- SET X=$$SETSTR^VALM1(" ",X,1,IBDVAL1)
- +10 SET X=$$SETSTR^VALM1(IBDVAL,X,IBDVAL1,25)
- DO TMP1
- DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- +11 SET X=""
- SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +12 SET X=$$SETSTR^VALM1(" ",X,1,3)
- DO TMP1
- +13 SET IBDCNT1=IBDCNT1-1
- +14 QUIT
- TMP1 ; -- Set up TMP Array
- +1 SET ^TMP("SSEL",$JOB,IBDCNT,0)=X
- SET ^TMP("SSEL",$JOB,"IDX",VALMCNT,IBDCNT1)=""
- +2 SET ^TMP("SELIDX",$JOB,IBDCNT1)=VALMCNT
- +3 QUIT