- 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 Feb 18, 2025@23:27:15 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
