[613] | 1 | DGJTEE1 ;MAF/ALB - CONT. ENTER EDIT DEFICIENCIES - JUNE 1992
|
---|
| 2 | ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
|
---|
| 3 | LOOP F DGJTCDIS=0:0 S DGJTCDIS=$O(^TMP("DGJ",$J,DGJTCDIS)) Q:DGJTCDIS']"" F DGJTYP=0:0 S DGJTYP=$O(^TMP("DGJ",$J,DGJTCDIS,DGJTYP)) Q:'DGJTYP F IFN=0:0 S IFN=$O(^TMP("DGJ",$J,DGJTCDIS,DGJTYP,IFN)) Q:'IFN D LOOP2
|
---|
| 4 | Q
|
---|
| 5 | LOOP2 Q:'$D(^VAS(393,IFN,0)) S DGJTADN=^VAS(393,IFN,0) Q:$P(DGJTDV,"^",1)'=$P(DGJTADN,"^",6) Q:DGJTAIFN'=$P(DGJTADN,"^",4) I '$D(DGJTDLT) D STATCK I $D(DGJFL1) K DGJFL1 Q
|
---|
| 6 | I $D(DGJTDLT),'$D(DGJVIEW),$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0))=DGJTYP Q
|
---|
| 7 | I DGJTAIFN]"" D SETG1 Q
|
---|
| 8 | Q
|
---|
| 9 | LOWER(X) ;
|
---|
| 10 | N Y,C,Z,I
|
---|
| 11 | S Y=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
|
---|
| 12 | 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)
|
---|
| 13 | Q Y
|
---|
| 14 | SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
|
---|
| 15 | ; S := string
|
---|
| 16 | ; V := destination
|
---|
| 17 | ; X := @ col X
|
---|
| 18 | ; L := # of chars
|
---|
| 19 | ;
|
---|
| 20 | Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
|
---|
| 21 | ;
|
---|
| 22 | STATCK ;Status check (complete)
|
---|
| 23 | S X=$P(DGJTADN,"^",11),DGJX=$P(DGJTADN,"^",6),DGJX=$G(^DG(40.8,DGJX,"DT"))
|
---|
| 24 | I $D(DGJTCOM) D
|
---|
| 25 | .I X=CM Q
|
---|
| 26 | .I $P(DGJX,"^",3)=1,X=RV Q
|
---|
| 27 | .I $P(DGJX,"^",3)=0,X=SN Q
|
---|
| 28 | .S DGJFL1=1
|
---|
| 29 | .Q
|
---|
| 30 | E D ;not complete
|
---|
| 31 | .I X=CM S DGJFL1=1 Q
|
---|
| 32 | .I $P(DGJX,"^",3)=1,X=RV S DGJFL1=1 Q
|
---|
| 33 | .I $P(DGJX,"^",3)=0,X=SN S DGJFL1=1 Q
|
---|
| 34 | Q
|
---|
| 35 | HDR S X=""
|
---|
| 36 | S X=$$SETSTR(" PATIENT: ",X,1,11)
|
---|
| 37 | S X=$$SETSTR($E($P($G(^DPT(DGJTPT,0)),"^",1),1,20),X,12,20)
|
---|
| 38 | S X=$$SETSTR("PT ID: ",X,40,7)
|
---|
| 39 | S X=$$SETSTR(DGJID,X,48,12)
|
---|
| 40 | S VALMHDR(1)=X
|
---|
| 41 | S X=""
|
---|
| 42 | S X=$$SETSTR("ADMISSION: ",X,1,11)
|
---|
| 43 | I $D(DGJTOA),+$G(DGJTX) S X=$$SETSTR($$FTIME^VALM1($P(DGJTOA(DGJTX),"^",2)),X,12,18)
|
---|
| 44 | I '$D(DGJTOA) S X=$$SETSTR("OUTPATIENT",X,12,10)
|
---|
| 45 | S VALMHDR(2)=X
|
---|
| 46 | Q
|
---|
| 47 | EXP ; -- expand
|
---|
| 48 | N DGJVALM,DGJAT,VALMY,DIR
|
---|
| 49 | S VALMBCK=""
|
---|
| 50 | D SEL^VALM2 G ENQ:'$O(VALMY(0)) S DGJVALM=0
|
---|
| 51 | D FULL^VALM1 S VALMBCK="R"
|
---|
| 52 | F S DGJVALM=$O(VALMY(DGJVALM)) Q:'DGJVALM D
|
---|
| 53 | .D FULL^VALM1
|
---|
| 54 | .S DGJAT=$G(^TMP("DGJIDX",$J,DGJVALM))
|
---|
| 55 | .W !!,^TMP("DGJDEF",$J,+DGJAT,0),!
|
---|
| 56 | .S (DA,DGJDFNO)=+$P(DGJAT,U,2),DIC="^VAS(393,",DR="0" D EN^DIQ,PAUSE^VALM1 I Y=""!(Y=0) S VALMBCK="R" Q
|
---|
| 57 | .I $D(DGJTSEDT) D EXP2 Q
|
---|
| 58 | .S DGJTYP=$P(^VAS(393.3,$P(^VAS(393,DA,0),"^",2),0),"^",1) I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"[DGJTYP S DGJTYP=$O(^VAS(393.3,"B",DGJTYP,0)) S DGJTAIFN=$P(^VAS(393,DA,0),"^",4),DGJTEDT="1^"_DA D EXP1
|
---|
| 59 | S VALMBCK="R"
|
---|
| 60 | ENQ Q
|
---|
| 61 | EXP1 D INIT3^DGJTEE2 S VALMBG=1,VALMBCK="R"
|
---|
| 62 | Q
|
---|
| 63 | EXP2 ;TS EDIT
|
---|
| 64 | Q:'$D(^VAS(393,DA,0)) I $P(^VAS(393,DA,0),"^",2)'=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) D TSEDIT,EVDT^DGJTEE G TSQ
|
---|
| 65 | S (X,DGJTNUM)=2 S DGJTNO="^^^"_DGJTAIFN D CK^DGJTVW1
|
---|
| 66 | Q
|
---|
| 67 | TSEDIT S DIE="^VAS(393,",DA=DA,DR=".07;.09;.1" D ^DIE Q
|
---|
| 68 | TSQ S VALMBG=1,VALMBCK="R" Q
|
---|
| 69 | PAT1 ; -- change pat
|
---|
| 70 | D FULL^VALM1 S VALMBG=1,VALMBCK="R"
|
---|
| 71 | K X,DGJCPSR1,DGJCPSR2 I $D(XQORNOD(0)) S X=$P($P(XQORNOD(0),U,4),"=",2)
|
---|
| 72 | S DGJCPDFN=DFN,DGJCPNOD=DGJTNODE S:$D(DGJTSR1) DGJCPSR1=DGJTSR1 S:$D(DGJTSR2) DGJCPSR2=DGJTSR2
|
---|
| 73 | I $G(DGJTSR1)=1 S DGJCPTX=DGJTX
|
---|
| 74 | K DGJTSR1,DGJTSR2
|
---|
| 75 | D PAT^DGJTEE
|
---|
| 76 | I Y<0!(DGJTFG=1)!('$D(DGJTSR1)&('$D(DGJTSR2))) S:DGJTAIFN]"" DGJTX=DGJCPTX,DGJTOA(DGJTX)=DGJTAIFN_"^"_$P(^DGPM(DGJTAIFN,0),"^",1) S (DFN,DGJTPT)=DGJCPDFN,DGJTNODE=DGJCPNOD D G PATQ
|
---|
| 77 | .S:$D(DGJCPSR1) DGJTSR1=DGJCPSR1 S:$D(DGJCPSR2) DGJTSR2=DGJCPSR2
|
---|
| 78 | .W !!,*7,"Patient has not been changed."
|
---|
| 79 | .W ! S DIR(0)="E" D ^DIR K DIR
|
---|
| 80 | .S DGJTFG=0 S VALMBCK="R"
|
---|
| 81 | D HDR^DGJTEE
|
---|
| 82 | PATQ Q
|
---|
| 83 | SETG1 I $D(DGJTREC) I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[($P(^VAS(393.3,$P(DGJTADN,"^",2),0),"^")) Q
|
---|
| 84 | S DGJTCAT=$P(^VAS(393.3,DGJTYP,0),"^",6)
|
---|
| 85 | S DGJCNT1=DGJCNT1+1
|
---|
| 86 | I '$D(DGJCAT(DGJTCAT)) D CATSET
|
---|
| 87 | S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
|
---|
| 88 | S X=$$SETSTR(DGJCNT1,X,1,3)
|
---|
| 89 | S DGJVAL=$P(DGJTADN,"^",2)
|
---|
| 90 | S X=$$SETSTR($$LOWER($P($G(^VAS(393.3,+DGJVAL,0)),"^")),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))
|
---|
| 91 | S X=$$SETSTR($$LOWER($P($G(^VA(200,+$P(DGJTADN,"^",14),0)),"^")),X,+PC,+PW)
|
---|
| 92 | S X=$$SETSTR($$LOWER($P($G(^DG(393.2,+$P(DGJTADN,"^",11),0)),"^")),X,+SC,+SW)
|
---|
| 93 | S DGX=$P($G(^VAS(393.3,+DGJVAL,0)),"^",6),DGX=$P($G(^VAS(393.41,+DGX,0)),"^") I DGX]"" S X=$$SETSTR($$LOWER(DGX),X,+CC,+CW)
|
---|
| 94 | I $P(DGJTADN,"^",3)]"" S DGX=$P(DGJTADN,"^",3) I DGX]"" S X=$$SETSTR($$LOWER($$FTIME^VALM1(DGX)),X,+EC,+EW)
|
---|
| 95 | S ^TMP("DGJDEF",$J,DGJCNT,0)=X,^TMP("DGJDEF",$J,"IDX",VALMCNT,DGJCNT1)=""
|
---|
| 96 | S ^TMP("DGJIDX",$J,DGJCNT1)=VALMCNT_"^"_IFN
|
---|
| 97 | Q
|
---|
| 98 | CATSET ;CATEGORY HEADING
|
---|
| 99 | S DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
|
---|
| 100 | S DGJCAT(DGJTCAT)=DGJCNT
|
---|
| 101 | S X=""
|
---|
| 102 | S X=$$SETSTR(" ",X,1,3) D TMP
|
---|
| 103 | S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
|
---|
| 104 | S DGJVAL=$P(^VAS(393.41,DGJTCAT,0),"^",1)
|
---|
| 105 | S DGJVAL1=$L(DGJVAL) S DGJVAL1=(80-DGJVAL1)/2 S DGJVAL1=DGJVAL1\1 S X=$$SETSTR(" ",X,1,DGJVAL1)
|
---|
| 106 | S X=$$SETSTR(DGJVAL,X,DGJVAL1,25) D TMP
|
---|
| 107 | S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
|
---|
| 108 | S X=$$SETSTR(" ",X,1,3) D TMP
|
---|
| 109 | Q
|
---|
| 110 | TMP S ^TMP("DGJDEF",$J,DGJCNT,0)=X,^TMP("DGJDEF",$J,"IDX",VALMCNT,DGJCNT1)=""
|
---|
| 111 | S ^TMP("DGJIDX",$J,DGJCNT1)=VALMCNT_"^"_IFN
|
---|
| 112 | Q
|
---|