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))
Q
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)
Q
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
Q
DT X ^DD("DD") W !,?10,DGJTCT_". "_Y I DGJTCT#5=0 D CHOZ
Q
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
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
Q
INIT I $D(DGJTDLT) D EN^VALM("DGJ DELETE RECORD") Q
D EN^VALM("DGJ IRT REC EDIT")
Q
INIT1 D EN^VALM("DGJ IRT REC ENTER")
Q
INIT3 D EN^VALM("DGJ EXP ENTRY")
Q
INIT4 ;
I $D(DGJTDLT) D EN^VALM("DGJ DELETE DEFICIENCY") Q
D EN^VALM("DGJ DEF EDIT")
Q
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
Q
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
