DGJTEE1.m

DGJTEE1 ;MAF/ALB - CONT. ENTER EDIT DEFICIENCIES - JUNE 1992

 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001

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

 Q

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

 I $D(DGJTDLT),'$D(DGJVIEW),$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0))=DGJTYP Q

 I DGJTAIFN]"" D SETG1 Q

 Q

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

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)

 ;

STATCK ;Status check (complete)

 S X=$P(DGJTADN,"^",11),DGJX=$P(DGJTADN,"^",6),DGJX=$G(^DG(40.8,DGJX,"DT"))

 I $D(DGJTCOM) D

 .I X=CM Q

 .I $P(DGJX,"^",3)=1,X=RV Q

 .I $P(DGJX,"^",3)=0,X=SN Q

 .S DGJFL1=1

 .Q

 E  D  ;not complete

 .I X=CM S DGJFL1=1 Q

 .I $P(DGJX,"^",3)=1,X=RV S DGJFL1=1 Q

 .I $P(DGJX,"^",3)=0,X=SN S DGJFL1=1 Q

 Q

HDR S X=""

 S X=$$SETSTR("  PATIENT: ",X,1,11)

 S X=$$SETSTR($E($P($G(^DPT(DGJTPT,0)),"^",1),1,20),X,12,20)

 S X=$$SETSTR("PT ID: ",X,40,7)

 S X=$$SETSTR(DGJID,X,48,12)

 S VALMHDR(1)=X

 S X=""

 S X=$$SETSTR("ADMISSION: ",X,1,11)

 I $D(DGJTOA),+$G(DGJTX) S X=$$SETSTR($$FTIME^VALM1($P(DGJTOA(DGJTX),"^",2)),X,12,18)

 I '$D(DGJTOA) S X=$$SETSTR("OUTPATIENT",X,12,10)

 S VALMHDR(2)=X

 Q

EXP ; -- expand

 N DGJVALM,DGJAT,VALMY,DIR

 S VALMBCK=""

 D SEL^VALM2 G ENQ:'$O(VALMY(0)) S DGJVALM=0

 D FULL^VALM1 S VALMBCK="R"

 F  S DGJVALM=$O(VALMY(DGJVALM)) Q:'DGJVALM  D

 .D FULL^VALM1

 .S DGJAT=$G(^TMP("DGJIDX",$J,DGJVALM))

 .W !!,^TMP("DGJDEF",$J,+DGJAT,0),!

 .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

 .I $D(DGJTSEDT) D EXP2 Q

 .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

 S VALMBCK="R"

ENQ Q

EXP1 D INIT3^DGJTEE2 S VALMBG=1,VALMBCK="R"

 Q

EXP2 ;TS EDIT

 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

 S (X,DGJTNUM)=2 S DGJTNO="^^^"_DGJTAIFN D CK^DGJTVW1

 Q

TSEDIT S DIE="^VAS(393,",DA=DA,DR=".07;.09;.1" D ^DIE Q

TSQ S VALMBG=1,VALMBCK="R" Q

PAT1 ; -- change pat

 D FULL^VALM1 S VALMBG=1,VALMBCK="R"

 K X,DGJCPSR1,DGJCPSR2 I $D(XQORNOD(0)) S X=$P($P(XQORNOD(0),U,4),"=",2)

 S DGJCPDFN=DFN,DGJCPNOD=DGJTNODE S:$D(DGJTSR1) DGJCPSR1=DGJTSR1 S:$D(DGJTSR2) DGJCPSR2=DGJTSR2

 I $G(DGJTSR1)=1 S DGJCPTX=DGJTX

 K DGJTSR1,DGJTSR2

 D PAT^DGJTEE

 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

 .S:$D(DGJCPSR1) DGJTSR1=DGJCPSR1 S:$D(DGJCPSR2) DGJTSR2=DGJCPSR2

 .W !!,*7,"Patient has not been changed."

 .W ! S DIR(0)="E" D ^DIR K DIR

 .S DGJTFG=0 S VALMBCK="R"

 D HDR^DGJTEE

PATQ Q

SETG1 I $D(DGJTREC) I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[($P(^VAS(393.3,$P(DGJTADN,"^",2),0),"^")) Q

 S DGJTCAT=$P(^VAS(393.3,DGJTYP,0),"^",6)

 S DGJCNT1=DGJCNT1+1

 I '$D(DGJCAT(DGJTCAT)) D CATSET

 S X="",DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1

 S X=$$SETSTR(DGJCNT1,X,1,3)

 S DGJVAL=$P(DGJTADN,"^",2)

 S X=$$SETSTR($$LOWER($P($G(^VAS(393.3,+DGJVAL,0)),"^")),X,+$S($D(DGJTREC):TC,1:DC),+$S($D(DGJTREC):TW,1:DW))

 S X=$$SETSTR($$LOWER($P($G(^VA(200,+$P(DGJTADN,"^",14),0)),"^")),X,+PC,+PW)

 S X=$$SETSTR($$LOWER($P($G(^DG(393.2,+$P(DGJTADN,"^",11),0)),"^")),X,+SC,+SW)

 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)

 I $P(DGJTADN,"^",3)]"" S DGX=$P(DGJTADN,"^",3) I DGX]"" S X=$$SETSTR($$LOWER($$FTIME^VALM1(DGX)),X,+EC,+EW)

 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGJTEE1   5006     printed  Mar 13, 2025@21:05:36                                                                                                                                                                                                     Page 2

DGJTEE1   ;MAF/ALB - CONT. ENTER EDIT DEFICIENCIES - JUNE 1992

 +1       ;;1.0;Incomplete Records Tracking;;Jun 25, 2001

LOOP       FOR DGJTCDIS=0:0

               SET DGJTCDIS=$ORDER(^TMP("DGJ",$JOB,DGJTCDIS))

               if DGJTCDIS']""

                   QUIT 

               FOR DGJTYP=0:0

                   SET DGJTYP=$ORDER(^TMP("DGJ",$JOB,DGJTCDIS,DGJTYP))

                   if 'DGJTYP

                       QUIT 

                   FOR IFN=0:0

                       SET IFN=$ORDER(^TMP("DGJ",$JOB,DGJTCDIS,DGJTYP,IFN))

                       if 'IFN

                           QUIT 

                       DO LOOP2

 +1        QUIT 

LOOP2      if '$DATA(^VAS(393,IFN,0))

               QUIT 

           SET DGJTADN=^VAS(393,IFN,0)

           if $PIECE(DGJTDV,"^",1)'=$PIECE(DGJTADN,"^",6)

               QUIT 

           if DGJTAIFN'=$PIECE(DGJTADN,"^",4)

               QUIT 

           IF '$DATA(DGJTDLT)

               DO STATCK

               IF $DATA(DGJFL1)

                   KILL DGJFL1

                   QUIT 

 +1        IF $DATA(DGJTDLT)

               IF '$DATA(DGJVIEW)

                   IF $ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))=DGJTYP

                       QUIT 

 +2        IF DGJTAIFN]""

               DO SETG1

               QUIT 

 +3        QUIT 

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

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       ;

STATCK    ;Status check (complete)

 +1        SET X=$PIECE(DGJTADN,"^",11)

           SET DGJX=$PIECE(DGJTADN,"^",6)

           SET DGJX=$GET(^DG(40.8,DGJX,"DT"))

 +2        IF $DATA(DGJTCOM)

               Begin DoDot:1

 +3                IF X=CM

                       QUIT 

 +4                IF $PIECE(DGJX,"^",3)=1

                       IF X=RV

                           QUIT 

 +5                IF $PIECE(DGJX,"^",3)=0

                       IF X=SN

                           QUIT 

 +6                SET DGJFL1=1

 +7                QUIT 

               End DoDot:1

 +8       ;not complete

          IF '$TEST

               Begin DoDot:1

 +9                IF X=CM

                       SET DGJFL1=1

                       QUIT 

 +10               IF $PIECE(DGJX,"^",3)=1

                       IF X=RV

                           SET DGJFL1=1

                           QUIT 

 +11               IF $PIECE(DGJX,"^",3)=0

                       IF X=SN

                           SET DGJFL1=1

                           QUIT 

               End DoDot:1

 +12       QUIT 

HDR        SET X=""

 +1        SET X=$$SETSTR("  PATIENT: ",X,1,11)

 +2        SET X=$$SETSTR($EXTRACT($PIECE($GET(^DPT(DGJTPT,0)),"^",1),1,20),X,12,20)

 +3        SET X=$$SETSTR("PT ID: ",X,40,7)

 +4        SET X=$$SETSTR(DGJID,X,48,12)

 +5        SET VALMHDR(1)=X

 +6        SET X=""

 +7        SET X=$$SETSTR("ADMISSION: ",X,1,11)

 +8        IF $DATA(DGJTOA)

               IF +$GET(DGJTX)

                   SET X=$$SETSTR($$FTIME^VALM1($PIECE(DGJTOA(DGJTX),"^",2)),X,12,18)

 +9        IF '$DATA(DGJTOA)

               SET X=$$SETSTR("OUTPATIENT",X,12,10)

 +10       SET VALMHDR(2)=X

 +11       QUIT 

EXP       ; -- expand

 +1        NEW DGJVALM,DGJAT,VALMY,DIR

 +2        SET VALMBCK=""

 +3        DO SEL^VALM2

           if '$ORDER(VALMY(0))

               GOTO ENQ

           SET DGJVALM=0

 +4        DO FULL^VALM1

           SET VALMBCK="R"

 +5        FOR 

               SET DGJVALM=$ORDER(VALMY(DGJVALM))

               if 'DGJVALM

                   QUIT 

               Begin DoDot:1

 +6                DO FULL^VALM1

 +7                SET DGJAT=$GET(^TMP("DGJIDX",$JOB,DGJVALM))

 +8                WRITE !!,^TMP("DGJDEF",$JOB,+DGJAT,0),!

 +9                SET (DA,DGJDFNO)=+$PIECE(DGJAT,U,2)

                   SET DIC="^VAS(393,"

                   SET DR="0"

                   DO EN^DIQ

                   DO PAUSE^VALM1

                   IF Y=""!(Y=0)

                       SET VALMBCK="R"

                       QUIT 

 +10               IF $DATA(DGJTSEDT)

                       DO EXP2

                       QUIT 

 +11               SET DGJTYP=$PIECE(^VAS(393.3,$PIECE(^VAS(393,DA,0),"^",2),0),"^",1)

                   IF "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"[DGJTYP

                       SET DGJTYP=$ORDER(^VAS(393.3,"B",DGJTYP,0))

                       SET DGJTAIFN=$PIECE(^VAS(393,DA,0),"^",4)

                       SET DGJTEDT="1^"_DA

                       DO EXP1

               End DoDot:1

 +12       SET VALMBCK="R"

ENQ        QUIT 

EXP1       DO INIT3^DGJTEE2

           SET VALMBG=1

           SET VALMBCK="R"

 +1        QUIT 

EXP2      ;TS EDIT

 +1        if '$DATA(^VAS(393,DA,0))

               QUIT 

           IF $PIECE(^VAS(393,DA,0),"^",2)'=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))

               DO TSEDIT

               DO EVDT^DGJTEE

               GOTO TSQ

 +2        SET (X,DGJTNUM)=2

           SET DGJTNO="^^^"_DGJTAIFN

           DO CK^DGJTVW1

 +3        QUIT 

TSEDIT     SET DIE="^VAS(393,"

           SET DA=DA

           SET DR=".07;.09;.1"

           DO ^DIE

           QUIT 

TSQ        SET VALMBG=1

           SET VALMBCK="R"

           QUIT 

PAT1      ; -- change pat

 +1        DO FULL^VALM1

           SET VALMBG=1

           SET VALMBCK="R"

 +2        KILL X,DGJCPSR1,DGJCPSR2

           IF $DATA(XQORNOD(0))

               SET X=$PIECE($PIECE(XQORNOD(0),U,4),"=",2)

 +3        SET DGJCPDFN=DFN

           SET DGJCPNOD=DGJTNODE

           if $DATA(DGJTSR1)

               SET DGJCPSR1=DGJTSR1

           if $DATA(DGJTSR2)

               SET DGJCPSR2=DGJTSR2

 +4        IF $GET(DGJTSR1)=1

               SET DGJCPTX=DGJTX

 +5        KILL DGJTSR1,DGJTSR2

 +6        DO PAT^DGJTEE

 +7        IF Y<0!(DGJTFG=1)!('$DATA(DGJTSR1)&('$DATA(DGJTSR2)))

               if DGJTAIFN]""

                   SET DGJTX=DGJCPTX

                   SET DGJTOA(DGJTX)=DGJTAIFN_"^"_$PIECE(^DGPM(DGJTAIFN,0),"^",1)

               SET (DFN,DGJTPT)=DGJCPDFN

               SET DGJTNODE=DGJCPNOD

               Begin DoDot:1

 +8                if $DATA(DGJCPSR1)

                       SET DGJTSR1=DGJCPSR1

                   if $DATA(DGJCPSR2)

                       SET DGJTSR2=DGJCPSR2

 +9                WRITE !!,*7,"Patient has not been changed."

 +10               WRITE !

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

 +11               SET DGJTFG=0

                   SET VALMBCK="R"

               End DoDot:1

               GOTO PATQ

 +12       DO HDR^DGJTEE

PATQ       QUIT 

SETG1      IF $DATA(DGJTREC)

               IF "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[($PIECE(^VAS(393.3,$PIECE(DGJTADN,"^",2),0),"^"))

                   QUIT 

 +1        SET DGJTCAT=$PIECE(^VAS(393.3,DGJTYP,0),"^",6)

 +2        SET DGJCNT1=DGJCNT1+1

 +3        IF '$DATA(DGJCAT(DGJTCAT))

               DO CATSET

 +4        SET X=""

           SET DGJCNT=DGJCNT+1

           SET VALMCNT=VALMCNT+1

 +5        SET X=$$SETSTR(DGJCNT1,X,1,3)

 +6        SET DGJVAL=$PIECE(DGJTADN,"^",2)

 +7        SET X=$$SETSTR($$LOWER($PIECE($GET(^VAS(393.3,+DGJVAL,0)),"^")),X,+$SELECT($DATA(DGJTREC):TC,1:DC),+$SELECT($DATA(DGJTREC):TW,1:DW))

 +8        SET X=$$SETSTR($$LOWER($PIECE($GET(^VA(200,+$PIECE(DGJTADN,"^",14),0)),"^")),X,+PC,+PW)

 +9        SET X=$$SETSTR($$LOWER($PIECE($GET(^DG(393.2,+$PIECE(DGJTADN,"^",11),0)),"^")),X,+SC,+SW)

 +10       SET DGX=$PIECE($GET(^VAS(393.3,+DGJVAL,0)),"^",6)

           SET DGX=$PIECE($GET(^VAS(393.41,+DGX,0)),"^")

           IF DGX]""

               SET X=$$SETSTR($$LOWER(DGX),X,+CC,+CW)

 +11       IF $PIECE(DGJTADN,"^",3)]""

               SET DGX=$PIECE(DGJTADN,"^",3)

               IF DGX]""

                   SET X=$$SETSTR($$LOWER($$FTIME^VALM1(DGX)),X,+EC,+EW)

 +12       SET ^TMP("DGJDEF",$JOB,DGJCNT,0)=X

           SET ^TMP("DGJDEF",$JOB,"IDX",VALMCNT,DGJCNT1)=""

 +13       SET ^TMP("DGJIDX",$JOB,DGJCNT1)=VALMCNT_"^"_IFN

 +14       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