- DGJTEE ;MAF,ESD/ALB - ENTER/EDIT OPTION AND MAIN LIST PROCESSOR RTN ; JUN 21 1992@800
- ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- START K XQORS,VALMEVL D EN^VALM("DGJ DEFICIENCY LIST")
- Q
- START1 K XQORS,VALMEVL D EN^VALM("DGJ IRT RECORD LIST")
- Q
- START2 K XQORS,VALMEVL D EN^VALM("DGJ DELETE SINGLE")
- Q
- START3 S DGJTOPT=1 D EN^VALM("DGJ COMP EDIT SINGLE")
- Q
- START4 D EN^VALM("DGJ COMP EDIT SUPER")
- Q
- START5 D EN^VALM("DGJ DELETE SUPER")
- Q
- START6 K XQORS,VALMEVL S DGJVIEW=1 D EN^VALM("DGJ IRT VIEW")
- K DGJVIEW Q
- EN S (DGJTDD,DGJTDBY,DGJTTD,DGJTTBY,DGJTSDT,DGJTSBY,DGJTOUT,DGJT2PH)="",(DGJTFG,DGJTAT,DGJTFLAG,DGJTIOFL,DGJCNT1)=0 S DGJTCFLG=1
- I $D(^DG(43,1,"GL")) S X=$P(^DG(43,1,"GL"),"^",2) I X=1 S DIR(0)="393,.06",DIR("A")="Select DIVISION " D ^DIR S:Y="^"!($D(DTOUT)) VALMQUIT="",DGJTFLAG=1 G:DGJTFLAG INITQ S DGJTDV=Y K DIR("A")
- I '$D(DGJTDV) S X=$O(^DG(40.8,0)) S DGJTDV=X_"^"_$P(^DG(40.8,+X,0),"^")
- S DGJTDEL=^DG(40.8,+DGJTDV,"DT") I $P(DGJTDEL,"^",5)=0 W !!?10,"This facility not tracking for OUTPATIENT OP REPORTS!",! S DGJTIOFL=1
- S (VALMCNT,DGJCNT)=0,VALMBG=1
- PAT K DGJTOA S DIC="^DPT(",DIC(0)="AQEMZ" D ^DIC
- I $D(DTOUT)!($D(DUOUT)) S VALMQUIT="" G INITQ
- I Y<0 G PAT
- S (DFN,DGJTPT)=+Y
- S DGJTNODE=^DPT(DFN,0) D PID^VADPT6 S DGJID=VA("PID")
- I DGJTIOFL S DGJTSR1=1 G INP
- OUT1 S DGJFL=0 W !!,"Display for: (I)Inpatients, (O)Outpatients INPATIENTS// " R X:DTIME S:X="^"!('$T) VALMQUIT="" G:X="^"!('$T) INITQ D ZSET2 I X=""!("Ii"[X) S X=1
- S X=$S("Oo"[X:2,1:X)
- I X="?" D ZSET2,HELP2 G OUT1
- S DGJTSR1=$E(X) D IN^DGJHELP W ! I %=-1 D ZSET2,HELP2 G OUT1
- I DGJTSR1=2 G EVDT
- INP D WARN^DGJTUTL I '$D(^UTILITY("DGJTADM",$J)) I $P(DGJTDEL,"^",5)=0!(DGJTSR1=1) G PAT
- I '$D(^UTILITY("DGJTADM",$J)),$P(DGJTDEL,"^",5) D NUL Q
- S DGJTFG=0 D LIST^DGJTEE2 I DGJTFG S VALMQUIT="" G INITQ
- EVDT D WAIT^DICD K ^TMP("DGJDEF",$J),DGJCAT,DGJDISD S (VALMCNT,DGJCNT,DGJCNT1,DGJTFG,DGJTFLG)=0 I DGJTSR1=2 S DGJTAIFN="" D SCR^DGJTEE3 D:'$O(^TMP("DGJDEF",$J,0)) NUL Q
- S DGJTDIV=$P(^DGPM(DGJTAIFN,0),"^",6),DGJTDIV=$P($G(^DIC(42,+DGJTDIV,0)),"^",11)
- S VALMBG=1,DGJTCT=0 F IFN=0:0 S IFN=$O(^VAS(393,"ADM",DGJTAIFN,IFN)) Q:'IFN I $D(^VAS(393,IFN,0)) S DGJTYP=$P(^VAS(393,IFN,0),"^",2) S DGJTCDIS=$S(DGJTYP]"":$P(^VAS(393.41,$P(^VAS(393.3,DGJTYP,0),"^",6),0),"^",4),1:"NOT SPECIFIED") D UTIL
- N CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW D INCSP^DGJTEE2 D LOOP^DGJTEE1 I '$O(^TMP("DGJDEF",$J,0)) D NUL
- Q
- UTIL S ^TMP("DGJ",$J,DGJTCDIS,DGJTYP,IFN)="" S:$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0))=DGJTYP DGJDISD=1 Q
- INITQ Q
- Q K DIC("A"),DIC("B"),DIC("S") S VALMBCK="R" Q
- ZSET2 S Z="^1 INPATIENTS^2 OUTPATIENTS^" Q
- HELP2 W !!,"Choose a number or first initial:" F K=2:1:3 W !?15,$P(Z,"^",K)
- W ! Q
- DATA I 'DGJTEDT S X=DGJTAIFN D NEW1
- Q
- NEW ;EDIT CODE
- N DGJVALM,DGJAT,VALMY
- S VALMBCK=""
- D SEL^VALM2 G ENQ:'$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,DIC="^VAS(393," D EN^DGJTEE2
- ENQ D REP Q
- FNL K DGJTDD,DGJTDBY,DGJTTD,DGJTTBY,DGJTSDT,DGJTSBY,DGJTOUT,DGJT2PH,DGJTFG,DGJTAT,DGJTFLAG,DGJTCFLG,DGJID,DGJTAIFN,DGJTDIV,DGJTDV,DGJTFLG,DGJTNODE,DGJTPT,VA,DGJTCT,DGJTIOFL,DGJTSR1,DGX,IFN,K,VALMQUIT,Z,DGJC,DGJFL,DGJTADTP,^TMP("DGJDEF",$J)
- K DGJTCNT,DGJTF,I,VAERR,DGJTOA,DGJDFNO,DGJI,DGJNOTY,DGJTFL,DGJTYP,DGJVAL,DGJTREC,DGJCAT,DGJCNT1,DGJTCAT,DGJTCDIS,DGJVAL1,DGJX,DGJCPDFN,DGJCPNOD,DGJCPSR1,DGJIFNO,^TMP("DGJ",$J),^TMP("DGJIDX",$J)
- K DGJTDT,DGJTDDT,DGJT1PH,DGJT,DGJTOPT,DGJTWD1,DGJTWD,DGJTSV,DGJTSP,DGJTPR,DIV,POP,S,VAIP,DGJCPTX,DGJDISD,DGJVIEW
- QUIT K %,%Y,DA,DFN,DGA1,DGJTADN,DGJTAIFN,DGJTCH,DGJTCH1,DGJCNT,DGJTDEF,DGJTDEL,DGJTDLT,DGJTEDT,DGJTEDT1,DGJTFG,DGJTFLG,DGJTIFN,DGJTST,DGJTX,DGT,DIC,DIE,DIK,DIR,DR,I,X,Y,^TMP("DGJDEF",$J) Q
- NEW1 ;ENTER CODE
- K DGJTEDT
- D FULL^VALM1
- CAT I DGJTSR1=1&('$D(DGJTREC)) N DGJY S DIC="^VAS(393.41,",DIC(0)="AEMN" D ^DIC K DIC G:X["^" REP G:Y<0 CAT S DGJY=+Y
- TYP I '$D(DGJTREC) S DIC("S")="I $P(^VAS(393.3,+Y,0),U,6)=+DGJY,$P(^VAS(393.3,+Y,0),U,7)=1" D CAT1
- I DGJTSR1=2 S DIC("S")="I $S(""^OP REPORT^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
- I DGJTSR1=1,$D(DGJTREC) S DIC("S")="I $S(""^OP REPORT^INTERIM SUMMARY^DISCHARGE SUMMARY^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
- S DIC="^VAS(393.3,",DIC("A")="Enter TYPE OF DEFICIENCY: ",DIC(0)="AEMQ" D ^DIC G Q:X["^"!($D(DTOUT)) S DGJTYP=+Y K DIC("S"),DIC("A"),DIC("B") I X']"" G TYP
- K DGJY D EDIT,REP Q
- CAT1 I $D(DGJDISD) S DIC("S")=DIC("S")_",""^DISCHARGE SUMMARY^""'[$P(^VAS(393.3,+Y,0),U,1)"
- Q
- EDIT D FULL^VALM1
- S DGJTDV=$P(DGJTDV,"^",1)
- D NEW^DGJTEE2
- Q
- REP K DR D EVDT S VALMBG=1,VALMBCK="R" Q
- HDR D HDR^DGJTEE1
- Q
- NUL ;NULL MESSAGE
- K ^TMP("DGJDEF",$J) S ^TMP("DGJDEF",$J,1,0)=" ",^TMP("DGJDEF",$J,2,0)=$S($D(DGJTCOM):"There are no Completed IRTs for this patient",1:"There are no DEFICIENCIES that meet this action's criteria."),^TMP("DGJIDX",$J,1)=1,^TMP("DGJIDX",$J,2)=2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJTEE 4985 printed Feb 18, 2025@23:27:12 Page 2
- DGJTEE ;MAF,ESD/ALB - ENTER/EDIT OPTION AND MAIN LIST PROCESSOR RTN ; JUN 21 1992@800
- +1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- START KILL XQORS,VALMEVL
- DO EN^VALM("DGJ DEFICIENCY LIST")
- +1 QUIT
- START1 KILL XQORS,VALMEVL
- DO EN^VALM("DGJ IRT RECORD LIST")
- +1 QUIT
- START2 KILL XQORS,VALMEVL
- DO EN^VALM("DGJ DELETE SINGLE")
- +1 QUIT
- START3 SET DGJTOPT=1
- DO EN^VALM("DGJ COMP EDIT SINGLE")
- +1 QUIT
- START4 DO EN^VALM("DGJ COMP EDIT SUPER")
- +1 QUIT
- START5 DO EN^VALM("DGJ DELETE SUPER")
- +1 QUIT
- START6 KILL XQORS,VALMEVL
- SET DGJVIEW=1
- DO EN^VALM("DGJ IRT VIEW")
- +1 KILL DGJVIEW
- QUIT
- EN SET (DGJTDD,DGJTDBY,DGJTTD,DGJTTBY,DGJTSDT,DGJTSBY,DGJTOUT,DGJT2PH)=""
- SET (DGJTFG,DGJTAT,DGJTFLAG,DGJTIOFL,DGJCNT1)=0
- SET DGJTCFLG=1
- +1 IF $DATA(^DG(43,1,"GL"))
- SET X=$PIECE(^DG(43,1,"GL"),"^",2)
- IF X=1
- SET DIR(0)="393,.06"
- SET DIR("A")="Select DIVISION "
- DO ^DIR
- if Y="^"!($DATA(DTOUT))
- SET VALMQUIT=""
- SET DGJTFLAG=1
- if DGJTFLAG
- GOTO INITQ
- SET DGJTDV=Y
- KILL DIR("A")
- +2 IF '$DATA(DGJTDV)
- SET X=$ORDER(^DG(40.8,0))
- SET DGJTDV=X_"^"_$PIECE(^DG(40.8,+X,0),"^")
- +3 SET DGJTDEL=^DG(40.8,+DGJTDV,"DT")
- IF $PIECE(DGJTDEL,"^",5)=0
- WRITE !!?10,"This facility not tracking for OUTPATIENT OP REPORTS!",!
- SET DGJTIOFL=1
- +4 SET (VALMCNT,DGJCNT)=0
- SET VALMBG=1
- PAT KILL DGJTOA
- SET DIC="^DPT("
- SET DIC(0)="AQEMZ"
- DO ^DIC
- +1 IF $DATA(DTOUT)!($DATA(DUOUT))
- SET VALMQUIT=""
- GOTO INITQ
- +2 IF Y<0
- GOTO PAT
- +3 SET (DFN,DGJTPT)=+Y
- +4 SET DGJTNODE=^DPT(DFN,0)
- DO PID^VADPT6
- SET DGJID=VA("PID")
- +5 IF DGJTIOFL
- SET DGJTSR1=1
- GOTO INP
- OUT1 SET DGJFL=0
- WRITE !!,"Display for: (I)Inpatients, (O)Outpatients INPATIENTS// "
- READ X:DTIME
- if X="^"!('$TEST)
- SET VALMQUIT=""
- if X="^"!('$TEST)
- GOTO INITQ
- DO ZSET2
- IF X=""!("Ii"[X)
- SET X=1
- +1 SET X=$SELECT("Oo"[X:2,1:X)
- +2 IF X="?"
- DO ZSET2
- DO HELP2
- GOTO OUT1
- +3 SET DGJTSR1=$EXTRACT(X)
- DO IN^DGJHELP
- WRITE !
- IF %=-1
- DO ZSET2
- DO HELP2
- GOTO OUT1
- +4 IF DGJTSR1=2
- GOTO EVDT
- INP DO WARN^DGJTUTL
- IF '$DATA(^UTILITY("DGJTADM",$JOB))
- IF $PIECE(DGJTDEL,"^",5)=0!(DGJTSR1=1)
- GOTO PAT
- +1 IF '$DATA(^UTILITY("DGJTADM",$JOB))
- IF $PIECE(DGJTDEL,"^",5)
- DO NUL
- QUIT
- +2 SET DGJTFG=0
- DO LIST^DGJTEE2
- IF DGJTFG
- SET VALMQUIT=""
- GOTO INITQ
- EVDT DO WAIT^DICD
- KILL ^TMP("DGJDEF",$JOB),DGJCAT,DGJDISD
- SET (VALMCNT,DGJCNT,DGJCNT1,DGJTFG,DGJTFLG)=0
- IF DGJTSR1=2
- SET DGJTAIFN=""
- DO SCR^DGJTEE3
- if '$ORDER(^TMP("DGJDEF",$JOB,0))
- DO NUL
- QUIT
- +1 SET DGJTDIV=$PIECE(^DGPM(DGJTAIFN,0),"^",6)
- SET DGJTDIV=$PIECE($GET(^DIC(42,+DGJTDIV,0)),"^",11)
- +2 SET VALMBG=1
- SET DGJTCT=0
- FOR IFN=0:0
- SET IFN=$ORDER(^VAS(393,"ADM",DGJTAIFN,IFN))
- if 'IFN
- QUIT
- IF $DATA(^VAS(393,IFN,0))
- SET DGJTYP=$PIECE(^VAS(393,IFN,0),"^",2)
- SET DGJTCDIS=$SELECT(DGJTYP]"":$PIECE(^VAS(393.41,$PIECE(^VAS(393.3,DGJTYP,0),"^",6),0),"^",4),1:"NOT SPECIFIED")
- DO UTIL
- +3 NEW CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW
- DO INCSP^DGJTEE2
- DO LOOP^DGJTEE1
- IF '$ORDER(^TMP("DGJDEF",$JOB,0))
- DO NUL
- +4 QUIT
- UTIL SET ^TMP("DGJ",$JOB,DGJTCDIS,DGJTYP,IFN)=""
- if $ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))=DGJTYP
- SET DGJDISD=1
- QUIT
- INITQ QUIT
- Q KILL DIC("A"),DIC("B"),DIC("S")
- SET VALMBCK="R"
- QUIT
- ZSET2 SET Z="^1 INPATIENTS^2 OUTPATIENTS^"
- QUIT
- HELP2 WRITE !!,"Choose a number or first initial:"
- FOR K=2:1:3
- WRITE !?15,$PIECE(Z,"^",K)
- +1 WRITE !
- QUIT
- DATA IF 'DGJTEDT
- SET X=DGJTAIFN
- DO NEW1
- +1 QUIT
- NEW ;EDIT CODE
- +1 NEW DGJVALM,DGJAT,VALMY
- +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 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 DIC="^VAS(393,"
- DO EN^DGJTEE2
- ENQ DO REP
- QUIT
- FNL KILL DGJTDD,DGJTDBY,DGJTTD,DGJTTBY,DGJTSDT,DGJTSBY,DGJTOUT,DGJT2PH,DGJTFG,DGJTAT,DGJTFLAG,DGJTCFLG,DGJID,DGJTAIFN,DGJTDIV,DGJTDV,DGJTFLG,DGJTNODE,DGJTPT,VA,DGJTCT,DGJTIOFL,DGJTSR1,DGX,IFN,K,VALMQUIT,Z,DGJC,DGJFL,DGJTADTP,^TMP("DGJDEF",$JOB)
- +1 KILL DGJTCNT,DGJTF,I,VAERR,DGJTOA,DGJDFNO,DGJI,DGJNOTY,DGJTFL,DGJTYP,DGJVAL,DGJTREC,DGJCAT,DGJCNT1,DGJTCAT,DGJTCDIS,DGJVAL1,DGJX,DGJCPDFN,DGJCPNOD,DGJCPSR1,DGJIFNO,^TMP("DGJ",$JOB),^TMP("DGJIDX",$JOB)
- +2 KILL DGJTDT,DGJTDDT,DGJT1PH,DGJT,DGJTOPT,DGJTWD1,DGJTWD,DGJTSV,DGJTSP,DGJTPR,DIV,POP,S,VAIP,DGJCPTX,DGJDISD,DGJVIEW
- QUIT KILL %,%Y,DA,DFN,DGA1,DGJTADN,DGJTAIFN,DGJTCH,DGJTCH1,DGJCNT,DGJTDEF,DGJTDEL,DGJTDLT,DGJTEDT,DGJTEDT1,DGJTFG,DGJTFLG,DGJTIFN,DGJTST,DGJTX,DGT,DIC,DIE,DIK,DIR,DR,I,X,Y,^TMP("DGJDEF",$JOB)
- QUIT
- NEW1 ;ENTER CODE
- +1 KILL DGJTEDT
- +2 DO FULL^VALM1
- CAT IF DGJTSR1=1&('$DATA(DGJTREC))
- NEW DGJY
- SET DIC="^VAS(393.41,"
- SET DIC(0)="AEMN"
- DO ^DIC
- KILL DIC
- if X["^"
- GOTO REP
- if Y<0
- GOTO CAT
- SET DGJY=+Y
- TYP IF '$DATA(DGJTREC)
- SET DIC("S")="I $P(^VAS(393.3,+Y,0),U,6)=+DGJY,$P(^VAS(393.3,+Y,0),U,7)=1"
- DO CAT1
- +1 IF DGJTSR1=2
- SET DIC("S")="I $S(""^OP REPORT^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
- +2 IF DGJTSR1=1
- IF $DATA(DGJTREC)
- SET DIC("S")="I $S(""^OP REPORT^INTERIM SUMMARY^DISCHARGE SUMMARY^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
- +3 SET DIC="^VAS(393.3,"
- SET DIC("A")="Enter TYPE OF DEFICIENCY: "
- SET DIC(0)="AEMQ"
- DO ^DIC
- if X["^"!($DATA(DTOUT))
- GOTO Q
- SET DGJTYP=+Y
- KILL DIC("S"),DIC("A"),DIC("B")
- IF X']""
- GOTO TYP
- +4 KILL DGJY
- DO EDIT
- DO REP
- QUIT
- CAT1 IF $DATA(DGJDISD)
- SET DIC("S")=DIC("S")_",""^DISCHARGE SUMMARY^""'[$P(^VAS(393.3,+Y,0),U,1)"
- +1 QUIT
- EDIT DO FULL^VALM1
- +1 SET DGJTDV=$PIECE(DGJTDV,"^",1)
- +2 DO NEW^DGJTEE2
- +3 QUIT
- REP KILL DR
- DO EVDT
- SET VALMBG=1
- SET VALMBCK="R"
- QUIT
- HDR DO HDR^DGJTEE1
- +1 QUIT
- NUL ;NULL MESSAGE
- +1 KILL ^TMP("DGJDEF",$JOB)
- SET ^TMP("DGJDEF",$JOB,1,0)=" "
- SET ^TMP("DGJDEF",$JOB,2,0)=$SELECT($DATA(DGJTCOM):"There are no Completed IRTs for this patient",1:"There are no DEFICIENCIES that meet this action's criteria.")
- SET ^TMP("DGJIDX",$JOB,1)=1
- SET ^TMP("DGJIDX",$JOB,2)=2
- +2 QUIT