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 Apr 09, 2024@21:02:45 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)
