Routine: DGJTEE2

DGJTEE2 ;ALB/MAF - ENTER/EDIT LIST PROCESSOR SET UP VARIABLES  ;SEP 5 1992@100

 ;;5.3;Registration;**9,163,242,1015**;Aug 13, 1993;Build 21

EN I $P(DGJTEDT,"^",1)=1 D EDIT Q

NEW D DATA^DGJTEE3

Q Q

EDIT S VALMBCK=""

 I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"[$P(^VAS(393.3,+$P(^VAS(393,$P(DGJTEDT,"^",2),0),"^",2),0),"^",1) D INIT^DGJTEE2 S VALMBCK="R" Q

 D INIT4

 S VALMBCK="R" Q

INCSP ;To increase speed of list.

 ; -- format vars     |- column -| |- width -|

 I $D(DGJTREC) S X=VALMDDF("RECORD TYPE"),TC=$P(X,U,2),TW=$P(X,U,3) ; T for record type

 I '$D(DGJTREC) S X=VALMDDF("DEFICIENCY"),DC=$P(X,U,2),DW=$P(X,U,3) ;  D for deficiency

 S X=VALMDDF("PHYSICIAN"),PC=$P(X,U,2),PW=$P(X,U,3) ;  P for physician

 S X=VALMDDF("STATUS"),SC=$P(X,U,2),SW=$P(X,U,3) ;  S for status

 S X=VALMDDF("CATEGORY"),CC=$P(X,U,2),CW=$P(X,U,3) ;  C for category

 S X=VALMDDF("EVENT DATE"),EC=$P(X,U,2),EW=$P(X,U,3) ;  E for event date

 S CM=$O(^DG(393.2,"B","COMPLETED",0))

 S RV=$O(^DG(393.2,"B","REVIEWED",0))

 S SN=$O(^DG(393.2,"B","SIGNED NO REVIEW",0))

LIST W ! S (DGJTCT,DGJC,DGJTX)=0

 F I=0:0 S I=$O(^UTILITY("DGJTADM",$J,I)) Q:'I!(DGJC)  F IFN=0:0 S IFN=$O(^UTILITY("DGJTADM",$J,I,IFN)) Q:'IFN!(DGJC)  S DGJTCT=DGJTCT+1,DGJTADN=^DGPM(IFN,0),Y=$P(DGJTADN,"^",1),DGJTOA(DGJTCT)=IFN_"^"_Y D DT1 I $D(DGJTCH)!($D(DGJTCH1)) Q:DGJC=1

 I $D(DGJTCH1) S DGJTFG=1 K DGJTCH1 Q

 K DGJTCH,DGJTCH1

 I DGJTCT#5'=0 D  S:X="^"!('$T) DGJTFG=1 Q:DGJTFG=1  I X["?"!(X?.A) G LIST

 . W !!,"Choose admission 1"

 . W $S(DGJTCT=1:" ",1:"-"_DGJTCT_" ")_" or '^' to QUIT: "

 . R X:DTIME

 I '$D(DGJTOA($S(X]"":X,1:0))) G LIST

 W ! S DGJTX=X

 S DGJTAIFN=$P(DGJTOA(+X),"^",1)

DT1 D DT1^DGJTEE3

 W !,$J(DGJTCT,4),">",?7,$$FMTE^XLFDT($E(Y,1,12),5),?26,$S($L(DGJTADTP)'>20:DGJTADTP,1:$E(DGJTADTP,1,20))

 S Z=+$G(^DGPM(+$P(DGJTADN,"^",17),0)) W ?49,"Discharged: ",?61,$S(Z:$$FMTE^XLFDT($E(Z,1,12),5),1:"N/A")

 I DGJTCT#5=0 D CHOZ

DT X ^DD("DD") W !,?10,DGJTCT_".  "_Y I DGJTCT#5=0 D CHOZ

CHOZ W !!,"Type '^' to QUIT, or <RETURN> to display more ",!

 W "Choose "_$S($D(DGJTRC):"Record ",1:"Admission "),1,$S(DGJTCT=1:"",1:"-"_DGJTCT),": " R X:DTIME S:'$T!(X["^") DGJTCH1=1,DGJC=1 I X I $D(DGJTOA(X))!($D(DGJTRC(X))) S DGJTCH=1,DGJTX=X,DGJC=1 Q

SETG ;SET UP TEMP GLOBAL

 N VALMCNT,DGJCNT

 S (VALMCNT,DGJCNT)=0

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

 S ^TMP("DGJRPT",$J,DGJCNT,0)=X,^TMP("DGJRPT",$J,"IDX",VALMCNT,DGJCNT)=""

 S ^TMP("DGJRPIDX",$J,DGJCNT)=VALMCNT_"^"_I

INIT I $D(DGJTDLT) D EN^VALM("DGJ DELETE RECORD") Q

 D EN^VALM("DGJ IRT REC EDIT")

INIT1 D EN^VALM("DGJ IRT REC ENTER")

INIT3 D EN^VALM("DGJ EXP ENTRY")

INIT4 ;

 I $D(DGJTDLT) D EN^VALM("DGJ DELETE DEFICIENCY") Q

 D EN^VALM("DGJ DEF EDIT")

QUICMP ;QUICK COMPLETE OF DEFICIENCIES ON THE SCREEN

 N DGJVALM,DGJAT,VALMY

 S VALMBCK=""

 D SEL^VALM2 G REP^DGJTEE:'$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=DA,DIE="^VAS(393,"  D SET

 G ENQ

SET I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"[$P(^VAS(393.3,+$P(^VAS(393,$P(DGJTEDT,"^",2),0),"^",2),0),"^",1) Q

 S DR=".11////"_$O(^DG(393.2,"B","COMPLETED",0)) D ^DIE K DR,DA

ENQ G REP^DGJTEE Q

QUIT K Z,DA,DFN,DIC,DIE,DIR,DR,DTOUT,I,IFN,PTF,VAIP,DGA1,DGJC,DGJT,DGJTADN,DGJTADTP,DGJTAT,DGJTCNT,DGJTCT,DGJTDT,DGJTDBY,DGJTDD,DGJTEDT,DGJTOUT,DGJTOA,DGJTOUT,DGJTRC,DGJTSBY,DGJTSDT,DGJTSP,DGJTSV,DGJTST,DGJTTBY,DGJTWD1,DGJFFL,DGJTPR

 K DGT,DGJTCFLG,DGJTSDT,DGJTTBY,DGJTTD,DGJTYP,DGJTWD,DGJTX,DGPM2X,DGPMCA,DGPMDCD,DGPMT,DGPMVI,DGPMY,DIV,X,^UTILITY("DGJTADM",$J),Y,OK,POP,VAERR,DGJT1PH,DGJT2PH,DGJTDEL,DGJTCH,DGJTCH1,DGJTFG,DGJTFL,DGJTDDT,DGJTF,VAINDT

 K DIC("S"),DIC("A") Q

DGJTEE2   ;ALB/MAF - ENTER/EDIT LIST PROCESSOR SET UP VARIABLES  ;SEP 5 1992@100

 +1       ;;5.3;Registration;**9,163,242,1015**;Aug 13, 1993;Build 21

EN         IF $PIECE(DGJTEDT,"^",1)=1

               DO EDIT

               QUIT

NEW        DO DATA^DGJTEE3

Q          QUIT

EDIT       SET VALMBCK=""

 +1        IF "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"[$PIECE(^VAS(393.3,+$PIECE(^VAS(393,$PIECE(DGJTEDT,"^",2),0),"^",2),0),"^",1)

               DO INIT^DGJTEE2

               SET VALMBCK="R"

               QUIT

 +2        DO INIT4

 +3        SET VALMBCK="R"

           QUIT

INCSP     ;To increase speed of list.

 +1       ; -- format vars     |- column -| |- width -|

 +2       ; T for record type

           IF $DATA(DGJTREC)

               SET X=VALMDDF("RECORD TYPE")

               SET TC=$PIECE(X,U,2)

               SET TW=$PIECE(X,U,3)

 +3       ;  D for deficiency

           IF '$DATA(DGJTREC)

               SET X=VALMDDF("DEFICIENCY")

               SET DC=$PIECE(X,U,2)

               SET DW=$PIECE(X,U,3)

 +4       ;  P for physician

           SET X=VALMDDF("PHYSICIAN")

           SET PC=$PIECE(X,U,2)

           SET PW=$PIECE(X,U,3)

 +5       ;  S for status

           SET X=VALMDDF("STATUS")

           SET SC=$PIECE(X,U,2)

           SET SW=$PIECE(X,U,3)

 +6       ;  C for category

           SET X=VALMDDF("CATEGORY")

           SET CC=$PIECE(X,U,2)

           SET CW=$PIECE(X,U,3)

 +7       ;  E for event date

           SET X=VALMDDF("EVENT DATE")

           SET EC=$PIECE(X,U,2)

           SET EW=$PIECE(X,U,3)

 +8        SET CM=$ORDER(^DG(393.2,"B","COMPLETED",0))

 +9        SET RV=$ORDER(^DG(393.2,"B","REVIEWED",0))

 +10       SET SN=$ORDER(^DG(393.2,"B","SIGNED NO REVIEW",0))

 +11       QUIT

LIST       WRITE !

           SET (DGJTCT,DGJC,DGJTX)=0

 +1        FOR I=0:0

               SET I=$ORDER(^UTILITY("DGJTADM",$JOB,I))

               IF 'I!(DGJC)

                   QUIT

               FOR IFN=0:0

                   SET IFN=$ORDER(^UTILITY("DGJTADM",$JOB,I,IFN))

                   IF 'IFN!(DGJC)

                       QUIT

                   SET DGJTCT=DGJTCT+1

                   SET DGJTADN=^DGPM(IFN,0)

                   SET Y=$PIECE(DGJTADN,"^",1)

                   SET DGJTOA(DGJTCT)=IFN_"^"_Y

                   DO DT1

                   IF $DATA(DGJTCH)!($DATA(DGJTCH1))

                       IF DGJC=1

                           QUIT

 +2        IF $DATA(DGJTCH1)

               SET DGJTFG=1

               KILL DGJTCH1

               QUIT

 +3        KILL DGJTCH,DGJTCH1

 +4        IF DGJTCT#5'=0

               Begin DoDot:1

 +5                WRITE !!,"Choose admission 1"

 +6                WRITE $SELECT(DGJTCT=1:" ",1:"-"_DGJTCT_" ")_" or '^' to QUIT: "

 +7                READ X:DTIME

               End DoDot:1

               IF X="^"!('$TEST)

                   SET DGJTFG=1

               IF DGJTFG=1

                   QUIT

               IF X["?"!(X?.A)

                   GOTO LIST

 +8        IF '$DATA(DGJTOA($SELECT(X]"":X,1:0)))

               GOTO LIST

 +9        WRITE !

           SET DGJTX=X

 +10       SET DGJTAIFN=$PIECE(DGJTOA(+X),"^",1)

 +11       QUIT

DT1        DO DT1^DGJTEE3

 +1        WRITE !,$JUSTIFY(DGJTCT,4),">",?7,$$FMTE^XLFDT($EXTRACT(Y,1,12),5),?26,$SELECT($LENGTH(DGJTADTP)'>20:DGJTADTP,1:$EXTRACT(DGJTADTP,1,20))

 +2        SET Z=+$GET(^DGPM(+$PIECE(DGJTADN,"^",17),0))

           WRITE ?49,"Discharged: ",?61,$SELECT(Z:$$FMTE^XLFDT($EXTRACT(Z,1,12),5),1:"N/A")

 +3        IF DGJTCT#5=0

               DO CHOZ

 +4        QUIT

DT         XECUTE ^DD("DD")

           WRITE !,?10,DGJTCT_".  "_Y

           IF DGJTCT#5=0

               DO CHOZ

 +1        QUIT

CHOZ       WRITE !!,"Type '^' to QUIT, or <RETURN> to display more ",!

 +1        WRITE "Choose "_$SELECT($DATA(DGJTRC):"Record ",1:"Admission "),1,$SELECT(DGJTCT=1:"",1:"-"_DGJTCT),": "

           READ X:DTIME

           IF '$TEST!(X["^")

               SET DGJTCH1=1

               SET DGJC=1

           IF X

               IF $DATA(DGJTOA(X))!($DATA(DGJTRC(X)))

                   SET DGJTCH=1

                   SET DGJTX=X

                   SET DGJC=1

                   QUIT

 +2        QUIT

SETG      ;SET UP TEMP GLOBAL

 +1        NEW VALMCNT,DGJCNT

 +2        SET (VALMCNT,DGJCNT)=0

 +3        SET X=""

           SET DGJCNT=DGJCNT+1

           SET VALMCNT=VALMCNT+1

 +4        SET ^TMP("DGJRPT",$JOB,DGJCNT,0)=X

           SET ^TMP("DGJRPT",$JOB,"IDX",VALMCNT,DGJCNT)=""

 +5        SET ^TMP("DGJRPIDX",$JOB,DGJCNT)=VALMCNT_"^"_I

 +6        QUIT

INIT       IF $DATA(DGJTDLT)

               DO EN^VALM("DGJ DELETE RECORD")

               QUIT

 +1        DO EN^VALM("DGJ IRT REC EDIT")

 +2        QUIT

INIT1      DO EN^VALM("DGJ IRT REC ENTER")

 +1        QUIT

INIT3      DO EN^VALM("DGJ EXP ENTRY")

 +1        QUIT

INIT4     ;

 +1        IF $DATA(DGJTDLT)

               DO EN^VALM("DGJ DELETE DEFICIENCY")

               QUIT

 +2        DO EN^VALM("DGJ DEF EDIT")

 +3        QUIT

QUICMP    ;QUICK COMPLETE OF DEFICIENCIES ON THE SCREEN

 +1        NEW DGJVALM,DGJAT,VALMY

 +2        SET VALMBCK=""

 +3        DO SEL^VALM2

           IF '$ORDER(VALMY(0))

               GOTO REP^DGJTEE

           SET DGJVALM=0

 +4        DO FULL^VALM1

           SET VALMBCK="R"

 +5        FOR DGJVALM=0:0

               SET DGJVALM=$ORDER(VALMY(DGJVALM))

               IF 'DGJVALM

                   QUIT

               SET DA=$PIECE($GET(^TMP("DGJIDX",$JOB,DGJVALM)),"^",2)

               IF DA]""

                   SET DGJTEDT="1^"_DA

                   SET DGJDFNO=DA

                   SET DIE="^VAS(393,"

                   DO SET

 +6        GOTO ENQ

SET        IF "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"[$PIECE(^VAS(393.3,+$PIECE(^VAS(393,$PIECE(DGJTEDT,"^",2),0),"^",2),0),"^",1)

               QUIT

 +1        SET DR=".11////"_$ORDER(^DG(393.2,"B","COMPLETED",0))

           DO ^DIE

           KILL DR,DA

 +2        QUIT

ENQ        GOTO REP^DGJTEE

           QUIT

QUIT       KILL Z,DA,DFN,DIC,DIE,DIR,DR,DTOUT,I,IFN,PTF,VAIP,DGA1,DGJC,DGJT,DGJTADN,DGJTADTP,DGJTAT,DGJTCNT,DGJTCT,DGJTDT,DGJTDBY,DGJTDD,DGJTEDT,DGJTOUT,DGJTOA,DGJTOUT,DGJTRC,DGJTSBY,DGJTSDT,DGJTSP,DGJTSV,DGJTST,DGJTTBY,DGJTWD1,DGJFFL,DGJTPR

 +1        KILL DGT,DGJTCFLG,DGJTSDT,DGJTTBY,DGJTTD,DGJTYP,DGJTWD,DGJTX,DGPM2X,DGPMCA,DGPMDCD,DGPMT,DGPMVI,DGPMY,DIV,X,^UTILITY("DGJTADM",$JOB),Y,OK,POP,VAERR,DGJT1PH,DGJT2PH,DGJTDEL,DGJTCH,DGJTCH1,DGJTFG,DGJTFL,DGJTDDT,DGJTF,VAINDT

 +2        KILL DIC("S"),DIC("A")

           QUIT

DGJTEE2.m