- IBDFLST1 ;ALM/MAF - Maintenance Utility Invalid Codes List - MAY 17 1995
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- ;
- S IBDCNT1=IBDCNT1+1
- S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S X=""
- S IBDFC(IBDFCAT)=IBDCNT_"^"_IBDFIFN
- S X=$$SETSTR(" ",X,1,3) D TMP
- S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S IBDVAL=IBDFCAT
- S IBDVAL1=$L(IBDVAL) S IBDVAL1=(80-IBDVAL1)/2 S IBDVAL1=IBDVAL1\1 S X=$$SETSTR(" ",X,1,IBDVAL1)
- S X=$$SETSTR(IBDVAL,X,IBDVAL1,25) D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
- S X=$$SETSTR(" ",X,1,3) D TMP
- S IBDCNT1=IBDCNT1-1
- Q
- ;
- ;
- SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
- ; S := string
- ; V := destination
- ; X := @ col X
- ; L := # of chars
- ;
- Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
- ;
- ;
- TMP ; -- Set up Array
- S ^TMP("CODE",$J,IBDCNT,0)=$$LOWER^VALM1(X),^TMP("CODE",$J,"IDX",VALMCNT,IBDCNT1)=""
- S ^TMP("CODEIDX",$J,IBDCNT1)=VALMCNT_"^"_IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
- Q
- ;
- ; -- Help code for display choices
- HELP1 W !!,"Choose a number or first initial :" F K=2:1:4 W !?15,$P(Z,"^",K)
- W ! Q
- ;
- ; -- Selections listed
- ZSET1 S Z="^1 [C]PT^2 [I]CD9^3 [V]ISIT^" Q
- ;
- ;
- IBDFLST1 ;ALM/MAF - Maintenance Utility Invalid Codes List - MAY 17 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 IBDFC(IBDFCAT)=IBDCNT_"^"_IBDFIFN
- +5 SET X=$$SETSTR(" ",X,1,3)
- DO TMP
- +6 SET X=""
- SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +7 SET IBDVAL=IBDFCAT
- +8 SET IBDVAL1=$LENGTH(IBDVAL)
- SET IBDVAL1=(80-IBDVAL1)/2
- SET IBDVAL1=IBDVAL1\1
- SET X=$$SETSTR(" ",X,1,IBDVAL1)
- +9 SET X=$$SETSTR(IBDVAL,X,IBDVAL1,25)
- DO TMP
- DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
- +10 SET X=""
- SET IBDCNT=IBDCNT+1
- SET VALMCNT=VALMCNT+1
- +11 SET X=$$SETSTR(" ",X,1,3)
- DO TMP
- +12 SET IBDCNT1=IBDCNT1-1
- +13 QUIT
- +14 ;
- +15 ;
- SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
- +1 ; S := string
- +2 ; V := destination
- +3 ; X := @ col X
- +4 ; L := # of chars
- +5 ;
- +6 QUIT $EXTRACT(V_$JUSTIFY("",X-1),1,X-1)_$EXTRACT(S_$JUSTIFY("",L),1,L)_$EXTRACT(V,X+L,999)
- +7 ;
- +8 ;
- TMP ; -- Set up Array
- +1 SET ^TMP("CODE",$JOB,IBDCNT,0)=$$LOWER^VALM1(X)
- SET ^TMP("CODE",$JOB,"IDX",VALMCNT,IBDCNT1)=""
- +2 SET ^TMP("CODEIDX",$JOB,IBDCNT1)=VALMCNT_"^"_IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
- +3 QUIT
- +4 ;
- +5 ; -- Help code for display choices
- HELP1 WRITE !!,"Choose a number or first initial :"
- FOR K=2:1:4
- WRITE !?15,$PIECE(Z,"^",K)
- +1 WRITE !
- QUIT
- +2 ;
- +3 ; -- Selections listed
- ZSET1 SET Z="^1 [C]PT^2 [I]CD9^3 [V]ISIT^"
- QUIT
- +1 ;
- +2 ;