- DGJPAR1 ;MAC/ALB - DEFICIENCIES PARAMETER SET UP FOR IRT ; MAY 13 1992@10:00
- ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- START K XQORS,VALMEVL D EN^VALM("DGJ ENTER/EDIT DEF. PARMS.")
- Q
- EVDT S DGJFLAG="" D WAIT^DICD K ^TMP("DGJDEF",$J),^TMP("DGJIDX",$J),^TMP("DGJ",$J),DGJCAT S (VALMCNT,DGJCNT,DGJCNT1,DGJTFG,DGJTFLG)=0 S DGJTSR1=1
- S DGJNAME=0,DGJTUP=1
- F X=0:0 S DGJNAME=$O(^VAS(393.3,"B",DGJNAME)) Q:DGJNAME=""!('$D(DGJTUP)) F IFN=0:0 S IFN=$O(^VAS(393.3,"B",DGJNAME,IFN)) Q:'IFN!('$D(DGJTUP)) S DGJTCDIS=$P($G(^VAS(393.41,$P(^VAS(393.3,IFN,0),"^",6),0)),"^",4) I DGJTCDIS]"" D UTIL
- S (CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW)="" D INCSP,LOOP I '$O(^TMP("DGJDEF",$J,0)) D NUL^DGJTEE
- S VALMSG="Highlighted Text is Uneditable...Enter ?? for help"
- Q
- LOOP F DGJTCDIS=0:0 S DGJTCDIS=$O(^TMP("DGJ",$J,DGJTCDIS)) Q:DGJTCDIS']"" F IFN=0:0 S IFN=$O(^TMP("DGJ",$J,DGJTCDIS,IFN)) Q:'IFN I $D(^VAS(393.3,IFN,0)) D SETG1
- Q
- QUIT K CC,CM,CW,DC,DGJAT,DGJCAT,DGJCNT,DGJCNT1,DGJDFNO,DGJFLAG,DGJTCAT,DGJTCDIS,DGJTEDT,DGJTFG,DGJTFLG,DGJTSR1,DGJTUP,DGJVAL,DGJVAL1,DGJVALM,DGJTX,DGX,DIC,DIE,DIR,DW,EC,EW,IOINHI,IOINORM,PC,PW,RV,SC,SN,SW,TC,TW,DA,DR,IFN,DGJNAME,POP,X,Y
- K DGJX1,DGJX2,^TMP("DGJ",$J),^TMP("DGJDEF",$J),^TMP("DGJIDX",$J) Q
- EDIT ;EDIT OF DEFICIENCIES ON THE SCREEN
- N DGJVALM,DGJAT,VALMY
- S VALMBCK=""
- D SEL^VALM2 G REP:'$O(VALMY(0)) S DGJVALM=0
- D FULL^VALM1 S VALMBCK="R"
- F DGJVALM=0:0 S DGJVALM=$O(VALMY(DGJVALM)) Q:'DGJVALM S DA=$P($G(^TMP("DGJIDX",$J,DGJVALM)),"^",2) I DA]"" S DGJTEDT="1^"_DA S (DGJDFNO,IFN)=DA D EDIT1,ABB,RSET I '$D(^VAS(393.3,+IFN,0)) S DGJFLAG=1
- I DGJFLAG]"" D KILL^VALM10() G REP
- S VALMBCK="R" Q
- EDIT1 S DGJX1=$P($G(^VAS(393.3,DA,0)),"^",6)
- W:$P($G(^VAS(393.3,DA,0)),"^",9)=1 !!,$P(^VAS(393.3,DA,0),"^",1) S DIE="^VAS(393.3,",DR=$S($P($G(^VAS(393.3,DA,0)),"^",9)=1:".07;.08",1:"[DGJ DEF PARAMETER EDIT]") D ^DIE Q:'$D(DGJTUP)
- S DGJX2=$P($G(^VAS(393.3,DA,0)),"^",6) I DGJX1'=DGJX2 S DGJFLAG=1
- Q
- RSET N DGJCNT1,VALMCNT,DGJCNT S DGJCNT1=DGJVALM,(VALMCNT,DGJCNT)=$P(^TMP("DGJIDX",$J,DGJVALM),"^",1) S X="" D RESET Q
- REP K DR D EVDT S VALMBG=1,VALMBCK="R" Q
- ABB S (CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW)="" D INCSP Q
- UTIL S ^TMP("DGJ",$J,DGJTCDIS,IFN)="" Q
- SETG1 S DGJTCAT=$P(^VAS(393.3,IFN,0),"^",6)
- S DGJCNT1=DGJCNT1+1
- I '$D(DGJCAT(DGJTCAT)) D CATSET
- S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
- RESET S X=$$SETSTR(DGJCNT1,X,1,3)
- I $P($G(^VAS(393.3,+IFN,0)),"^",9)=1 D FLDCTRL^VALM10(VALMCNT,"DEFICIENCY",IOINHI,IOINORM) D FLDCTRL^VALM10(VALMCNT,"CATEGORY",IOINHI,IOINORM)
- ;S X=$$SETSTR($$LOWER($P($G(^VAS(393.3,+IFN,0)),"^")),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))
- S X=$$SETSTR($P($G(^VAS(393.3,+IFN,0)),"^"),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))
- S X=$$SETSTR($$LOWER($S($P($G(^VAS(393.3,+IFN,0)),"^",7)=1:"YES",1:"NO")),X,PC,PW)
- S X=$$SETSTR($$LOWER($S($P($G(^VAS(393.3,+IFN,0)),"^",8)=1:"YES",1:"NO")),X,SC,SW)
- S DGX=$P($G(^VAS(393.3,IFN,0)),"^",6),DGX=$P($G(^VAS(393.41,+DGX,0)),"^") I DGX]"" S X=$$SETSTR($$LOWER(DGX),X,+CC,+CW)
- S ^TMP("DGJDEF",$J,DGJCNT,0)=X,^TMP("DGJDEF",$J,"IDX",VALMCNT,DGJCNT1)=""
- S ^TMP("DGJIDX",$J,DGJCNT1)=VALMCNT_"^"_IFN
- Q
- CATSET ;CATEGORY HEADING
- S DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
- S DGJCAT(DGJTCAT)=DGJCNT
- S X=""
- S X=$$SETSTR(" ",X,1,3) D TMP
- S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
- S DGJVAL=$P(^VAS(393.41,DGJTCAT,0),"^",1)
- S DGJVAL1=$L(DGJVAL) S DGJVAL1=(80-DGJVAL1)/2 S DGJVAL1=DGJVAL1\1 S X=$$SETSTR(" ",X,1,DGJVAL1)
- S X=$$SETSTR(DGJVAL,X,DGJVAL1,25) D TMP
- S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
- S X=$$SETSTR(" ",X,1,3) D TMP
- Q
- TMP S ^TMP("DGJDEF",$J,DGJCNT,0)=X,^TMP("DGJDEF",$J,"IDX",VALMCNT,DGJCNT1)=""
- S ^TMP("DGJIDX",$J,DGJCNT1)=VALMCNT_"^"_IFN
- 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)
- ;
- LOWER(X) ;
- N Y,C,Z,I
- S Y=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
- F C=" ",",","/" S I=0 F S I=$F(Y,C,I) Q:'I S Y=$E(Y,1,I-1)_$TR($E(Y,I),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(Y,I+1,999)
- Q Y
- INCSP ;To increase speed of list.
- ; -- format vars |- column -| |- width -|
- I '$D(DGJTREC) S X=VALMDDF("DEFICIENCY"),DC=$P(X,U,2),DW=$P(X,U,3) ; D for deficiency
- S X=VALMDDF("TRACK DEF"),PC=$P(X,U,2),PW=$P(X,U,3) ; P for track deficiency
- S X=VALMDDF("STANDARD DEF"),SC=$P(X,U,2),SW=$P(X,U,3) ; S for standard deficiency
- S X=VALMDDF("CATEGORY"),CC=$P(X,U,2),CW=$P(X,U,3) ; C for category
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJPAR1 4635 printed Jan 18, 2025@03:01:54 Page 2
- DGJPAR1 ;MAC/ALB - DEFICIENCIES PARAMETER SET UP FOR IRT ; MAY 13 1992@10:00
- +1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- START KILL XQORS,VALMEVL
- DO EN^VALM("DGJ ENTER/EDIT DEF. PARMS.")
- +1 QUIT
- EVDT SET DGJFLAG=""
- DO WAIT^DICD
- KILL ^TMP("DGJDEF",$JOB),^TMP("DGJIDX",$JOB),^TMP("DGJ",$JOB),DGJCAT
- SET (VALMCNT,DGJCNT,DGJCNT1,DGJTFG,DGJTFLG)=0
- SET DGJTSR1=1
- +1 SET DGJNAME=0
- SET DGJTUP=1
- +2 FOR X=0:0
- SET DGJNAME=$ORDER(^VAS(393.3,"B",DGJNAME))
- if DGJNAME=""!('$DATA(DGJTUP))
- QUIT
- FOR IFN=0:0
- SET IFN=$ORDER(^VAS(393.3,"B",DGJNAME,IFN))
- if 'IFN!('$DATA(DGJTUP))
- QUIT
- SET DGJTCDIS=$PIECE($GET(^VAS(393.41,$PIECE(^VAS(393.3,IFN,0),"^",6),0)),"^",4)
- IF DGJTCDIS]""
- DO UTIL
- +3 SET (CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW)=""
- DO INCSP
- DO LOOP
- IF '$ORDER(^TMP("DGJDEF",$JOB,0))
- DO NUL^DGJTEE
- +4 SET VALMSG="Highlighted Text is Uneditable...Enter ?? for help"
- +5 QUIT
- LOOP FOR DGJTCDIS=0:0
- SET DGJTCDIS=$ORDER(^TMP("DGJ",$JOB,DGJTCDIS))
- if DGJTCDIS']""
- QUIT
- FOR IFN=0:0
- SET IFN=$ORDER(^TMP("DGJ",$JOB,DGJTCDIS,IFN))
- if 'IFN
- QUIT
- IF $DATA(^VAS(393.3,IFN,0))
- DO SETG1
- +1 QUIT
- QUIT KILL CC,CM,CW,DC,DGJAT,DGJCAT,DGJCNT,DGJCNT1,DGJDFNO,DGJFLAG,DGJTCAT,DGJTCDIS,DGJTEDT,DGJTFG,DGJTFLG,DGJTSR1,DGJTUP,DGJVAL,DGJVAL1,DGJVALM,DGJTX,DGX,DIC,DIE,DIR,DW,EC,EW,IOINHI,IOINORM,PC,PW,RV,SC,SN,SW,TC,TW,DA,DR,IFN,DGJNAME,POP,X,Y
- +1 KILL DGJX1,DGJX2,^TMP("DGJ",$JOB),^TMP("DGJDEF",$JOB),^TMP("DGJIDX",$JOB)
- QUIT
- EDIT ;EDIT OF DEFICIENCIES ON THE SCREEN
- +1 NEW DGJVALM,DGJAT,VALMY
- +2 SET VALMBCK=""
- +3 DO SEL^VALM2
- if '$ORDER(VALMY(0))
- GOTO REP
- SET DGJVALM=0
- +4 DO FULL^VALM1
- SET VALMBCK="R"
- +5 FOR DGJVALM=0:0
- SET DGJVALM=$ORDER(VALMY(DGJVALM))
- if 'DGJVALM
- QUIT
- SET DA=$PIECE($GET(^TMP("DGJIDX",$JOB,DGJVALM)),"^",2)
- IF DA]""
- SET DGJTEDT="1^"_DA
- SET (DGJDFNO,IFN)=DA
- DO EDIT1
- DO ABB
- DO RSET
- IF '$DATA(^VAS(393.3,+IFN,0))
- SET DGJFLAG=1
- +6 IF DGJFLAG]""
- DO KILL^VALM10()
- GOTO REP
- +7 SET VALMBCK="R"
- QUIT
- EDIT1 SET DGJX1=$PIECE($GET(^VAS(393.3,DA,0)),"^",6)
- +1 if $PIECE($GET(^VAS(393.3,DA,0)),"^",9)=1
- WRITE !!,$PIECE(^VAS(393.3,DA,0),"^",1)
- SET DIE="^VAS(393.3,"
- SET DR=$SELECT($PIECE($GET(^VAS(393.3,DA,0)),"^",9)=1:".07;.08",1:"[DGJ DEF PARAMETER EDIT]")
- DO ^DIE
- if '$DATA(DGJTUP)
- QUIT
- +2 SET DGJX2=$PIECE($GET(^VAS(393.3,DA,0)),"^",6)
- IF DGJX1'=DGJX2
- SET DGJFLAG=1
- +3 QUIT
- RSET NEW DGJCNT1,VALMCNT,DGJCNT
- SET DGJCNT1=DGJVALM
- SET (VALMCNT,DGJCNT)=$PIECE(^TMP("DGJIDX",$JOB,DGJVALM),"^",1)
- SET X=""
- DO RESET
- QUIT
- REP KILL DR
- DO EVDT
- SET VALMBG=1
- SET VALMBCK="R"
- QUIT
- ABB SET (CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW)=""
- DO INCSP
- QUIT
- UTIL SET ^TMP("DGJ",$JOB,DGJTCDIS,IFN)=""
- QUIT
- SETG1 SET DGJTCAT=$PIECE(^VAS(393.3,IFN,0),"^",6)
- +1 SET DGJCNT1=DGJCNT1+1
- +2 IF '$DATA(DGJCAT(DGJTCAT))
- DO CATSET
- +3 SET X=""
- SET DGJCNT=DGJCNT+1
- SET VALMCNT=VALMCNT+1
- RESET SET X=$$SETSTR(DGJCNT1,X,1,3)
- +1 IF $PIECE($GET(^VAS(393.3,+IFN,0)),"^",9)=1
- DO FLDCTRL^VALM10(VALMCNT,"DEFICIENCY",IOINHI,IOINORM)
- DO FLDCTRL^VALM10(VALMCNT,"CATEGORY",IOINHI,IOINORM)
- +2 ;S X=$$SETSTR($$LOWER($P($G(^VAS(393.3,+IFN,0)),"^")),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))
- +3 SET X=$$SETSTR($PIECE($GET(^VAS(393.3,+IFN,0)),"^"),X,+$SELECT($DATA(DGJTREC):TC,1:DC),+$SELECT($DATA(DGJTREC):TW,1:DW))
- +4 SET X=$$SETSTR($$LOWER($SELECT($PIECE($GET(^VAS(393.3,+IFN,0)),"^",7)=1:"YES",1:"NO")),X,PC,PW)
- +5 SET X=$$SETSTR($$LOWER($SELECT($PIECE($GET(^VAS(393.3,+IFN,0)),"^",8)=1:"YES",1:"NO")),X,SC,SW)
- +6 SET DGX=$PIECE($GET(^VAS(393.3,IFN,0)),"^",6)
- SET DGX=$PIECE($GET(^VAS(393.41,+DGX,0)),"^")
- IF DGX]""
- SET X=$$SETSTR($$LOWER(DGX),X,+CC,+CW)
- +7 SET ^TMP("DGJDEF",$JOB,DGJCNT,0)=X
- SET ^TMP("DGJDEF",$JOB,"IDX",VALMCNT,DGJCNT1)=""
- +8 SET ^TMP("DGJIDX",$JOB,DGJCNT1)=VALMCNT_"^"_IFN
- +9 QUIT
- CATSET ;CATEGORY HEADING
- +1 SET DGJCNT=DGJCNT+1
- SET VALMCNT=VALMCNT+1
- +2 SET DGJCAT(DGJTCAT)=DGJCNT
- +3 SET X=""
- +4 SET X=$$SETSTR(" ",X,1,3)
- DO TMP
- +5 SET X=""
- SET DGJCNT=DGJCNT+1
- SET VALMCNT=VALMCNT+1
- +6 SET DGJVAL=$PIECE(^VAS(393.41,DGJTCAT,0),"^",1)
- +7 SET DGJVAL1=$LENGTH(DGJVAL)
- SET DGJVAL1=(80-DGJVAL1)/2
- SET DGJVAL1=DGJVAL1\1
- SET X=$$SETSTR(" ",X,1,DGJVAL1)
- +8 SET X=$$SETSTR(DGJVAL,X,DGJVAL1,25)
- DO TMP
- +9 SET X=""
- SET DGJCNT=DGJCNT+1
- SET VALMCNT=VALMCNT+1
- +10 SET X=$$SETSTR(" ",X,1,3)
- DO TMP
- +11 QUIT
- TMP SET ^TMP("DGJDEF",$JOB,DGJCNT,0)=X
- SET ^TMP("DGJDEF",$JOB,"IDX",VALMCNT,DGJCNT1)=""
- +1 SET ^TMP("DGJIDX",$JOB,DGJCNT1)=VALMCNT_"^"_IFN
- +2 QUIT
- 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 ;
- LOWER(X) ;
- +1 NEW Y,C,Z,I
- +2 SET Y=$EXTRACT(X)_$TRANSLATE($EXTRACT(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
- +3 FOR C=" ",",","/"
- SET I=0
- FOR
- SET I=$FIND(Y,C,I)
- if 'I
- QUIT
- SET Y=$EXTRACT(Y,1,I-1)_$TRANSLATE($EXTRACT(Y,I),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(Y,I+1,999)
- +4 QUIT Y
- INCSP ;To increase speed of list.
- +1 ; -- format vars |- column -| |- width -|
- +2 ; D for deficiency
- IF '$DATA(DGJTREC)
- SET X=VALMDDF("DEFICIENCY")
- SET DC=$PIECE(X,U,2)
- SET DW=$PIECE(X,U,3)
- +3 ; P for track deficiency
- SET X=VALMDDF("TRACK DEF")
- SET PC=$PIECE(X,U,2)
- SET PW=$PIECE(X,U,3)
- +4 ; S for standard deficiency
- SET X=VALMDDF("STANDARD DEF")
- SET SC=$PIECE(X,U,2)
- SET SW=$PIECE(X,U,3)
- +5 ; C for category
- SET X=VALMDDF("CATEGORY")
- SET CC=$PIECE(X,U,2)
- SET CW=$PIECE(X,U,3)