source: FOIAVistA/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJPAR1.m@ 1397

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