DGJTEE3 ;ALB/MAF - ENTER/EDIT (CONT) LIST PROCESSOR SET UP VARIABLES CONT. ;SEP 5 1992@100
;;1.0;Incomplete Records Tracking;;Jun 25, 2001
DATA N DA K DIR("A"),DIR("B") S DIR(0)="393,.03" D ^DIR G Q:Y="^"!$D(DTOUT) S DGJTDT=Y
I DGJTAIFN]"",$D(^DGPM(DGJTAIFN,0)),Y<+^DGPM(DGJTAIFN,0) S Y=+^DGPM(DGJTAIFN,0) X ^DD("DD") W !!?10,"Event Date must be after admission"," ",Y,! G DATA
I DGJTAIFN]"" S X=$S($D(^DGPM(DGJTAIFN,0)):$P(^(0),"^",17),1:"") I $D(^DGPM(+X,0)),Y>+^DGPM(+X,0) S Y=+^DGPM(+X,0) X ^DD("DD") W !!?10,"Event date must not be after discharge date"," ",Y,! G DATA
I DGJTYP=1 S VAIP("D")="L"
I DGJTYP'=1 S VAIP("D")=$S($P(DGJTDT,".",2)]"":DGJTDT,1:DGJTDT_".2400")
I DGJTSR1=1 D IN5^VADPT
K DIR("A"),DIR("B") I $D(VAIP(5)) S:VAIP(5)]"" DIR("B")=$P(VAIP(5),"^",2)
S DIR(0)="393,.05" D ^DIR G Q:X["^"!$D(DTOUT) S DGJTWD=+Y,DGJTWD1=$S($D(^SC(DGJTWD,42)):+^(42),1:0) K DIR("B")
I $D(VAIP(8)) I VAIP(8)]"" S DIR("B")=$P(VAIP(8),"^",2)
S DIR(0)="393,.07" D ^DIR G Q:X["^"!$D(DTOUT) S DGJTSP=+Y K DIR("B")
I '$D(^DIC(42,+DGJTWD1,0)) S DGJTSV=$P(^SC(+DGJTWD,0),"^",8)
I $D(^DIC(42,+DGJTWD1,0)) S DGJTSV=$P(^(0),"^",3)
S:DGJTSV="" DGJTSV=0 S DGJTSV=$S(DGJTSV=0:12,$D(^DG(393.1,"AC",DGJTSV)):$O(^(DGJTSV,0)),1:"") I DGJTSV]"" S (DGJTSV,DIR("B"))=$P(^DG(393.1,+DGJTSV,0),"^",1)
S DIR(0)="393,.08" D ^DIR G Q:X["^"!$D(DTOUT) S DGJTSV=+Y K DIR("B")
I DGJTSR1=1 S X=$P(DGJTDEL,"^",2) D DOC S:X]"" DIR("B")=X
S DIR(0)="393,.09" D ^DIR G Q:X["^"!$D(DTOUT) S DGJT1PH=+Y K DIR("B")
S X="" I $P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A") S:DGJTSR1=1 X=$P(DGJTDEL,"^",10)
S X="" I $P(DGJTDEL,"^",3)=1 S:DGJTSR1=1 X=$P(DGJTDEL,"^",4)
I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) D:DGJTSR1=1 DOC S:X]"" DIR("B")=X S DIR(0)="393,.1" D ^DIR G Q:X["^"!$D(DTOUT) I Y'=-1 S DGJT2PH=$S(Y]"":+Y,1:"@")
S DIR("B")=$S(DGJT1PH]"":$P(^VA(200,DGJT1PH,0),"^",1),1:"")
S DIR(0)="393,.12" D ^DIR G Q:X["^"!$D(DTOUT) S DGJTPR=+Y K DIR("B")
FILE K DD,DO S DGSENFLG="",DIC="^VAS(393,",DIC(0)="EL",X=DFN D FILE^DICN K DIC,DGSENFLG
S DGJTEDT="1^"_+Y,DIE="^VAS(393,",DA=+Y
I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[$P(^VAS(393.3,DGJTYP,0),"^",1) S DR="[DGJ ENTER IRT DEFICIENCY]" D ^DIE Q
I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"[$P(^VAS(393.3,DGJTYP,0),"^",1) S DR="[DGJ ENTER IRT RECORD]"
D ^DIE
D INIT1^DGJTEE2 Q
Q I X="^"!($D(DTOUT)) S VALMBG=1,VALMBCK="R"
Q
SCR S DGJTCT=0 F IFN=0:0 S IFN=$O(^VAS(393,"B",DFN,IFN)) Q:'IFN I $D(^VAS(393,IFN,0)),$P(^VAS(393,IFN,0),"^",4)="" D SCR1
Q
SCR1 S DGJTF=0 D DIVCK S DGJTADN=^VAS(393,IFN,0) Q:$P(DGJTDV,"^",1)'=$P(DGJTADN,"^",6) S DGJTYP=$P(DGJTADN,"^",2) N CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW D INCSP^DGJTEE2 I '$D(DGJTDLT) D STATCK^DGJTEE1 I $D(DGJFL1) K DGJFL1 Q
D SETG1^DGJTEE1
Q
DIVCK S X=$P(^VAS(393,IFN,0),"^",6) I X'=+DGJTDV S DGJTF=1
S DGJTDEL=$S($D(^DG(40.8,+X,"DT")):^("DT"),1:DGJTDEL)
S X=$S($P(DGJTDEL,"^",3)=0:$O(^DG(393.2,"B","SIGNED",0)),1:$O(^DG(393.2,"B","REVIEWED",0))) Q
DOC S DGJT=$S($D(^DGPM(+VAIP(1),0)):$P(^(0),"^",14),1:""),DGJT=$O(^DGPM("ATS",DFN,+DGJT,0)),DGJT=$O(^(+DGJT,0)),DGJT=$O(^(+DGJT,0)),DGJT=$S($D(^DGPM(+DGJT,0)):^(0),1:"") ;last treating specialty mvt
D DOC1 S X=$S($D(^VA(200,+X,0)):$P(^(0),U),1:"") Q
DOC1 ;provider responsible
S X=$S(X="A":$P(DGJT,"^",19),X="N":"",1:$P(DGJT,"^",8))
Q
DT1 S DGJTADTP=+DGJTOA(DGJTCT),DGJTADTP=$S($D(^DGPM(DGJTADTP,0)):$P(^(0),"^",18),1:"") I DGJTADTP]"" S DGJTADTP=$S($D(^DG(405.2,+DGJTADTP,0)):$P(^(0),"^",1),1:"") Q
Q
TMP ;
K ^TMP("DGJRPT",$J)
N VALMCNT,DGJCNT
S X="",(VALMCNT,DGJCNT)=0,VALMBG=1
S X=$$SETSTR^VALM1("No Deficiency was created for this Patient",X,1,50)
D TMP^DGJTVW2
Q
JUMP D FULL^VALM1 I $D(XQORNOD(0)),$P(XQORNOD(0),"^",4)]"" S X=$P(XQORNOD(0),"^",4) S X=$P(X,"=",2) I X]"" S DIC="^VAS(393.41,",DIC(0)="QEZ" D ^DIC G:Y<0 JMP S Y=+Y D JUMP1 Q
JMP S DIC="^VAS(393.41,",DIC(0)="AEMN",DIC("A")="Select Category you wish to move to: " D ^DIC K DIC
I X["^" S VALMBG=1,VALMBCK="R" Q
JUMP1 I Y<0 G JUMP
N DGJXCAT
S DGJXCAT=+Y
I '$D(DGJCAT(DGJXCAT)) W !!,"This Category does not contain any deficiencies." G JMP
S VALMBG=DGJCAT(DGJXCAT) S VALMBCK="R" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJTEE3 4210 printed Nov 22, 2024@17:11 Page 2
DGJTEE3 ;ALB/MAF - ENTER/EDIT (CONT) LIST PROCESSOR SET UP VARIABLES CONT. ;SEP 5 1992@100
+1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
DATA NEW DA
KILL DIR("A"),DIR("B")
SET DIR(0)="393,.03"
DO ^DIR
if Y="^"!$DATA(DTOUT)
GOTO Q
SET DGJTDT=Y
+1 IF DGJTAIFN]""
IF $DATA(^DGPM(DGJTAIFN,0))
IF Y<+^DGPM(DGJTAIFN,0)
SET Y=+^DGPM(DGJTAIFN,0)
XECUTE ^DD("DD")
WRITE !!?10,"Event Date must be after admission"," ",Y,!
GOTO DATA
+2 IF DGJTAIFN]""
SET X=$SELECT($DATA(^DGPM(DGJTAIFN,0)):$PIECE(^(0),"^",17),1:"")
IF $DATA(^DGPM(+X,0))
IF Y>+^DGPM(+X,0)
SET Y=+^DGPM(+X,0)
XECUTE ^DD("DD")
WRITE !!?10,"Event date must not be after discharge date"," ",Y,!
GOTO DATA
+3 IF DGJTYP=1
SET VAIP("D")="L"
+4 IF DGJTYP'=1
SET VAIP("D")=$SELECT($PIECE(DGJTDT,".",2)]"":DGJTDT,1:DGJTDT_".2400")
+5 IF DGJTSR1=1
DO IN5^VADPT
+6 KILL DIR("A"),DIR("B")
IF $DATA(VAIP(5))
if VAIP(5)]""
SET DIR("B")=$PIECE(VAIP(5),"^",2)
+7 SET DIR(0)="393,.05"
DO ^DIR
if X["^"!$DATA(DTOUT)
GOTO Q
SET DGJTWD=+Y
SET DGJTWD1=$SELECT($DATA(^SC(DGJTWD,42)):+^(42),1:0)
KILL DIR("B")
+8 IF $DATA(VAIP(8))
IF VAIP(8)]""
SET DIR("B")=$PIECE(VAIP(8),"^",2)
+9 SET DIR(0)="393,.07"
DO ^DIR
if X["^"!$DATA(DTOUT)
GOTO Q
SET DGJTSP=+Y
KILL DIR("B")
+10 IF '$DATA(^DIC(42,+DGJTWD1,0))
SET DGJTSV=$PIECE(^SC(+DGJTWD,0),"^",8)
+11 IF $DATA(^DIC(42,+DGJTWD1,0))
SET DGJTSV=$PIECE(^(0),"^",3)
+12 if DGJTSV=""
SET DGJTSV=0
SET DGJTSV=$SELECT(DGJTSV=0:12,$DATA(^DG(393.1,"AC",DGJTSV)):$ORDER(^(DGJTSV,0)),1:"")
IF DGJTSV]""
SET (DGJTSV,DIR("B"))=$PIECE(^DG(393.1,+DGJTSV,0),"^",1)
+13 SET DIR(0)="393,.08"
DO ^DIR
if X["^"!$DATA(DTOUT)
GOTO Q
SET DGJTSV=+Y
KILL DIR("B")
+14 IF DGJTSR1=1
SET X=$PIECE(DGJTDEL,"^",2)
DO DOC
if X]""
SET DIR("B")=X
+15 SET DIR(0)="393,.09"
DO ^DIR
if X["^"!$DATA(DTOUT)
GOTO Q
SET DGJT1PH=+Y
KILL DIR("B")
+16 SET X=""
IF $PIECE(DGJTDEL,"^",3)=0&($PIECE(DGJTDEL,"^",10)="A")
if DGJTSR1=1
SET X=$PIECE(DGJTDEL,"^",10)
+17 SET X=""
IF $PIECE(DGJTDEL,"^",3)=1
if DGJTSR1=1
SET X=$PIECE(DGJTDEL,"^",4)
+18 IF $PIECE(DGJTDEL,"^",3)=1!($PIECE(DGJTDEL,"^",3)=0&($PIECE(DGJTDEL,"^",10)="A"))
if DGJTSR1=1
DO DOC
if X]""
SET DIR("B")=X
SET DIR(0)="393,.1"
DO ^DIR
if X["^"!$DATA(DTOUT)
GOTO Q
IF Y'=-1
SET DGJT2PH=$SELECT(Y]"":+Y,1:"@")
+19 SET DIR("B")=$SELECT(DGJT1PH]"":$PIECE(^VA(200,DGJT1PH,0),"^",1),1:"")
+20 SET DIR(0)="393,.12"
DO ^DIR
if X["^"!$DATA(DTOUT)
GOTO Q
SET DGJTPR=+Y
KILL DIR("B")
FILE KILL DD,DO
SET DGSENFLG=""
SET DIC="^VAS(393,"
SET DIC(0)="EL"
SET X=DFN
DO FILE^DICN
KILL DIC,DGSENFLG
+1 SET DGJTEDT="1^"_+Y
SET DIE="^VAS(393,"
SET DA=+Y
+2 IF "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[$PIECE(^VAS(393.3,DGJTYP,0),"^",1)
SET DR="[DGJ ENTER IRT DEFICIENCY]"
DO ^DIE
QUIT
+3 IF "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"[$PIECE(^VAS(393.3,DGJTYP,0),"^",1)
SET DR="[DGJ ENTER IRT RECORD]"
+4 DO ^DIE
+5 DO INIT1^DGJTEE2
QUIT
Q IF X="^"!($DATA(DTOUT))
SET VALMBG=1
SET VALMBCK="R"
+1 QUIT
SCR SET DGJTCT=0
FOR IFN=0:0
SET IFN=$ORDER(^VAS(393,"B",DFN,IFN))
if 'IFN
QUIT
IF $DATA(^VAS(393,IFN,0))
IF $PIECE(^VAS(393,IFN,0),"^",4)=""
DO SCR1
+1 QUIT
SCR1 SET DGJTF=0
DO DIVCK
SET DGJTADN=^VAS(393,IFN,0)
if $PIECE(DGJTDV,"^",1)'=$PIECE(DGJTADN,"^",6)
QUIT
SET DGJTYP=$PIECE(DGJTADN,"^",2)
NEW CC,CM,CW,DC,DW,EC,EW,PC,PW,RV,SC,SN,SW,TC,TW
DO INCSP^DGJTEE2
IF '$DATA(DGJTDLT)
DO STATCK^DGJTEE1
IF $DATA(DGJFL1)
KILL DGJFL1
QUIT
+1 DO SETG1^DGJTEE1
+2 QUIT
DIVCK SET X=$PIECE(^VAS(393,IFN,0),"^",6)
IF X'=+DGJTDV
SET DGJTF=1
+1 SET DGJTDEL=$SELECT($DATA(^DG(40.8,+X,"DT")):^("DT"),1:DGJTDEL)
+2 SET X=$SELECT($PIECE(DGJTDEL,"^",3)=0:$ORDER(^DG(393.2,"B","SIGNED",0)),1:$ORDER(^DG(393.2,"B","REVIEWED",0)))
QUIT
DOC ;last treating specialty mvt
SET DGJT=$SELECT($DATA(^DGPM(+VAIP(1),0)):$PIECE(^(0),"^",14),1:"")
SET DGJT=$ORDER(^DGPM("ATS",DFN,+DGJT,0))
SET DGJT=$ORDER(^(+DGJT,0))
SET DGJT=$ORDER(^(+DGJT,0))
SET DGJT=$SELECT($DATA(^DGPM(+DGJT,0)):^(0),1:"")
+1 DO DOC1
SET X=$SELECT($DATA(^VA(200,+X,0)):$PIECE(^(0),U),1:"")
QUIT
DOC1 ;provider responsible
+1 SET X=$SELECT(X="A":$PIECE(DGJT,"^",19),X="N":"",1:$PIECE(DGJT,"^",8))
+2 QUIT
DT1 SET DGJTADTP=+DGJTOA(DGJTCT)
SET DGJTADTP=$SELECT($DATA(^DGPM(DGJTADTP,0)):$PIECE(^(0),"^",18),1:"")
IF DGJTADTP]""
SET DGJTADTP=$SELECT($DATA(^DG(405.2,+DGJTADTP,0)):$PIECE(^(0),"^",1),1:"")
QUIT
+1 QUIT
TMP ;
+1 KILL ^TMP("DGJRPT",$JOB)
+2 NEW VALMCNT,DGJCNT
+3 SET X=""
SET (VALMCNT,DGJCNT)=0
SET VALMBG=1
+4 SET X=$$SETSTR^VALM1("No Deficiency was created for this Patient",X,1,50)
+5 DO TMP^DGJTVW2
+6 QUIT
JUMP DO FULL^VALM1
IF $DATA(XQORNOD(0))
IF $PIECE(XQORNOD(0),"^",4)]""
SET X=$PIECE(XQORNOD(0),"^",4)
SET X=$PIECE(X,"=",2)
IF X]""
SET DIC="^VAS(393.41,"
SET DIC(0)="QEZ"
DO ^DIC
if Y<0
GOTO JMP
SET Y=+Y
DO JUMP1
QUIT
JMP SET DIC="^VAS(393.41,"
SET DIC(0)="AEMN"
SET DIC("A")="Select Category you wish to move to: "
DO ^DIC
KILL DIC
+1 IF X["^"
SET VALMBG=1
SET VALMBCK="R"
QUIT
JUMP1 IF Y<0
GOTO JUMP
+1 NEW DGJXCAT
+2 SET DGJXCAT=+Y
+3 IF '$DATA(DGJCAT(DGJXCAT))
WRITE !!,"This Category does not contain any deficiencies."
GOTO JMP
+4 SET VALMBG=DGJCAT(DGJXCAT)
SET VALMBCK="R"
QUIT
+5 QUIT
