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

Last change on this file since 1071 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1DGJPAR1 ;MAC/ALB - DEFICIENCIES PARAMETER SET UP FOR IRT ; MAY 13 1992@10:00
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3START K XQORS,VALMEVL D EN^VALM("DGJ ENTER/EDIT DEF. PARMS.")
4 Q
5EVDT 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
6 S DGJNAME=0,DGJTUP=1
7 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
8 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
9 S VALMSG="Highlighted Text is Uneditable...Enter ?? for help"
10 Q
11LOOP 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
12 Q
13QUIT 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
14 K DGJX1,DGJX2,^TMP("DGJ",$J),^TMP("DGJDEF",$J),^TMP("DGJIDX",$J) Q
15EDIT ;EDIT OF DEFICIENCIES ON THE SCREEN
16 N DGJVALM,DGJAT,VALMY
17 S VALMBCK=""
18 D SEL^VALM2 G REP:'$O(VALMY(0)) S DGJVALM=0
19 D FULL^VALM1 S VALMBCK="R"
20 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
21 I DGJFLAG]"" D KILL^VALM10() G REP
22 S VALMBCK="R" Q
23EDIT1 S DGJX1=$P($G(^VAS(393.3,DA,0)),"^",6)
24 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)
25 S DGJX2=$P($G(^VAS(393.3,DA,0)),"^",6) I DGJX1'=DGJX2 S DGJFLAG=1
26 Q
27RSET N DGJCNT1,VALMCNT,DGJCNT S DGJCNT1=DGJVALM,(VALMCNT,DGJCNT)=$P(^TMP("DGJIDX",$J,DGJVALM),"^",1) S X="" D RESET Q
28REP K DR D EVDT S VALMBG=1,VALMBCK="R" Q
29ABB S (CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW)="" D INCSP Q
30UTIL S ^TMP("DGJ",$J,DGJTCDIS,IFN)="" Q
31SETG1 S DGJTCAT=$P(^VAS(393.3,IFN,0),"^",6)
32 S DGJCNT1=DGJCNT1+1
33 I '$D(DGJCAT(DGJTCAT)) D CATSET
34 S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
35RESET S X=$$SETSTR(DGJCNT1,X,1,3)
36 I $P($G(^VAS(393.3,+IFN,0)),"^",9)=1 D FLDCTRL^VALM10(VALMCNT,"DEFICIENCY",IOINHI,IOINORM) D FLDCTRL^VALM10(VALMCNT,"CATEGORY",IOINHI,IOINORM)
37 ;S X=$$SETSTR($$LOWER($P($G(^VAS(393.3,+IFN,0)),"^")),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))
38 S X=$$SETSTR($P($G(^VAS(393.3,+IFN,0)),"^"),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))
39 S X=$$SETSTR($$LOWER($S($P($G(^VAS(393.3,+IFN,0)),"^",7)=1:"YES",1:"NO")),X,PC,PW)
40 S X=$$SETSTR($$LOWER($S($P($G(^VAS(393.3,+IFN,0)),"^",8)=1:"YES",1:"NO")),X,SC,SW)
41 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)
42 S ^TMP("DGJDEF",$J,DGJCNT,0)=X,^TMP("DGJDEF",$J,"IDX",VALMCNT,DGJCNT1)=""
43 S ^TMP("DGJIDX",$J,DGJCNT1)=VALMCNT_"^"_IFN
44 Q
45CATSET ;CATEGORY HEADING
46 S DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
47 S DGJCAT(DGJTCAT)=DGJCNT
48 S X=""
49 S X=$$SETSTR(" ",X,1,3) D TMP
50 S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
51 S DGJVAL=$P(^VAS(393.41,DGJTCAT,0),"^",1)
52 S DGJVAL1=$L(DGJVAL) S DGJVAL1=(80-DGJVAL1)/2 S DGJVAL1=DGJVAL1\1 S X=$$SETSTR(" ",X,1,DGJVAL1)
53 S X=$$SETSTR(DGJVAL,X,DGJVAL1,25) D TMP
54 S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
55 S X=$$SETSTR(" ",X,1,3) D TMP
56 Q
57TMP S ^TMP("DGJDEF",$J,DGJCNT,0)=X,^TMP("DGJDEF",$J,"IDX",VALMCNT,DGJCNT1)=""
58 S ^TMP("DGJIDX",$J,DGJCNT1)=VALMCNT_"^"_IFN
59 Q
60SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
61 ; S := string
62 ; V := destination
63 ; X := @ col X
64 ; L := # of chars
65 ;
66 Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
67 ;
68LOWER(X) ;
69 N Y,C,Z,I
70 S Y=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
71 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)
72 Q Y
73INCSP ;To increase speed of list.
74 ; -- format vars |- column -| |- width -|
75 I '$D(DGJTREC) S X=VALMDDF("DEFICIENCY"),DC=$P(X,U,2),DW=$P(X,U,3) ; D for deficiency
76 S X=VALMDDF("TRACK DEF"),PC=$P(X,U,2),PW=$P(X,U,3) ; P for track deficiency
77 S X=VALMDDF("STANDARD DEF"),SC=$P(X,U,2),SW=$P(X,U,3) ; S for standard deficiency
78 S X=VALMDDF("CATEGORY"),CC=$P(X,U,2),CW=$P(X,U,3) ; C for category
Note: See TracBrowser for help on using the repository browser.