Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGJPAR1

DGJPAR1.m

Go to the documentation of this file.
  1. DGJPAR1 ;MAC/ALB - DEFICIENCIES PARAMETER SET UP FOR IRT ; MAY 13 1992@10:00
  1. ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
  1. START K XQORS,VALMEVL D EN^VALM("DGJ ENTER/EDIT DEF. PARMS.")
  1. Q
  1. 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
  1. S DGJNAME=0,DGJTUP=1
  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
  1. 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
  1. S VALMSG="Highlighted Text is Uneditable...Enter ?? for help"
  1. Q
  1. 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
  1. Q
  1. 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
  1. K DGJX1,DGJX2,^TMP("DGJ",$J),^TMP("DGJDEF",$J),^TMP("DGJIDX",$J) Q
  1. EDIT ;EDIT OF DEFICIENCIES ON THE SCREEN
  1. N DGJVALM,DGJAT,VALMY
  1. S VALMBCK=""
  1. D SEL^VALM2 G REP:'$O(VALMY(0)) S DGJVALM=0
  1. D FULL^VALM1 S VALMBCK="R"
  1. 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
  1. I DGJFLAG]"" D KILL^VALM10() G REP
  1. S VALMBCK="R" Q
  1. EDIT1 S DGJX1=$P($G(^VAS(393.3,DA,0)),"^",6)
  1. 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)
  1. S DGJX2=$P($G(^VAS(393.3,DA,0)),"^",6) I DGJX1'=DGJX2 S DGJFLAG=1
  1. Q
  1. RSET N DGJCNT1,VALMCNT,DGJCNT S DGJCNT1=DGJVALM,(VALMCNT,DGJCNT)=$P(^TMP("DGJIDX",$J,DGJVALM),"^",1) S X="" D RESET Q
  1. REP K DR D EVDT S VALMBG=1,VALMBCK="R" Q
  1. ABB S (CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW)="" D INCSP Q
  1. UTIL S ^TMP("DGJ",$J,DGJTCDIS,IFN)="" Q
  1. SETG1 S DGJTCAT=$P(^VAS(393.3,IFN,0),"^",6)
  1. S DGJCNT1=DGJCNT1+1
  1. I '$D(DGJCAT(DGJTCAT)) D CATSET
  1. S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
  1. RESET S X=$$SETSTR(DGJCNT1,X,1,3)
  1. I $P($G(^VAS(393.3,+IFN,0)),"^",9)=1 D FLDCTRL^VALM10(VALMCNT,"DEFICIENCY",IOINHI,IOINORM) D FLDCTRL^VALM10(VALMCNT,"CATEGORY",IOINHI,IOINORM)
  1. ;S X=$$SETSTR($$LOWER($P($G(^VAS(393.3,+IFN,0)),"^")),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))
  1. S X=$$SETSTR($P($G(^VAS(393.3,+IFN,0)),"^"),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))
  1. S X=$$SETSTR($$LOWER($S($P($G(^VAS(393.3,+IFN,0)),"^",7)=1:"YES",1:"NO")),X,PC,PW)
  1. S X=$$SETSTR($$LOWER($S($P($G(^VAS(393.3,+IFN,0)),"^",8)=1:"YES",1:"NO")),X,SC,SW)
  1. 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)
  1. S ^TMP("DGJDEF",$J,DGJCNT,0)=X,^TMP("DGJDEF",$J,"IDX",VALMCNT,DGJCNT1)=""
  1. S ^TMP("DGJIDX",$J,DGJCNT1)=VALMCNT_"^"_IFN
  1. Q
  1. CATSET ;CATEGORY HEADING
  1. S DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
  1. S DGJCAT(DGJTCAT)=DGJCNT
  1. S X=""
  1. S X=$$SETSTR(" ",X,1,3) D TMP
  1. S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
  1. S DGJVAL=$P(^VAS(393.41,DGJTCAT,0),"^",1)
  1. S DGJVAL1=$L(DGJVAL) S DGJVAL1=(80-DGJVAL1)/2 S DGJVAL1=DGJVAL1\1 S X=$$SETSTR(" ",X,1,DGJVAL1)
  1. S X=$$SETSTR(DGJVAL,X,DGJVAL1,25) D TMP
  1. S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
  1. S X=$$SETSTR(" ",X,1,3) D TMP
  1. Q
  1. TMP S ^TMP("DGJDEF",$J,DGJCNT,0)=X,^TMP("DGJDEF",$J,"IDX",VALMCNT,DGJCNT1)=""
  1. S ^TMP("DGJIDX",$J,DGJCNT1)=VALMCNT_"^"_IFN
  1. Q
  1. SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
  1. ; S := string
  1. ; V := destination
  1. ; X := @ col X
  1. ; L := # of chars
  1. ;
  1. Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
  1. ;
  1. LOWER(X) ;
  1. N Y,C,Z,I
  1. S Y=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
  1. 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)
  1. Q Y
  1. INCSP ;To increase speed of list.
  1. ; -- format vars |- column -| |- width -|
  1. I '$D(DGJTREC) S X=VALMDDF("DEFICIENCY"),DC=$P(X,U,2),DW=$P(X,U,3) ; D for deficiency
  1. S X=VALMDDF("TRACK DEF"),PC=$P(X,U,2),PW=$P(X,U,3) ; P for track deficiency
  1. S X=VALMDDF("STANDARD DEF"),SC=$P(X,U,2),SW=$P(X,U,3) ; S for standard deficiency
  1. S X=VALMDDF("CATEGORY"),CC=$P(X,U,2),CW=$P(X,U,3) ; C for category