DGJTUTL ;ALB/MIR - ZSECUTABLE HELP FOR EVENT DATE IN INCOMPLETE RECORD FILE ; 04 JAN 91
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
N DFN,I,J,OK,PTF S DFN=+^VAS(393,DA,0)
D WARN
;
W !,"Choose from:"
F I=0:0 S I=$O(^UTILITY("DGJTADM",$J,I)) Q:'I S Y=+^DGPM(I,0) X ^DD("DD") W !?5,Y
;
PTF ;Check to make sure PTF exists and it is not closed
S OK=$S('$D(^DGPT(+PTF)):0,$D(^DGP(45.84,+PTF)):0,1:1)
Q
PHYSRTRG S DGJTEST=$P(^VAS(393,D0,0),"^",11) S X=$S(DGJTEST=$O(^DG(393.2,"B","TRANSCRIBED",0)):0,DGJTEST=$O(^DG(393.2,"B","SIGNED",0)):0,DGJTEST=$O(^DG(393.2,"B","REVIEWED",0)):0,1:1) K DGJTEST Q
LESS48 ;Checking for discharge summary less than 48 hours.
I $D(^VAS(393,DA,"DT")),$P(^("DT"),"^",1)]"" S X=0 Q
S (DGJTX4,X1)=$P(^DGPM(+$P(DGJTNO,"^",4),0),"^",1),DGJTX3=+$P(DGJTNO,"^",3) S X2=2 D C^%DTC I DGJTX3<X&($P(DGJTNO,"^",3)>DGJTX4) D ASK K DGJTX3,DGJTX4
Q
ASK W !!,"Will this Discharge Summary <48 hrs need to be dictated? "
S %=2 D YN^DICN I '% W !,"ENTER:",!?10,"Y for YES",!?10,"N for NO",!?10,"^ to EXIT" G ASK
S X=$S(%=2:1,%=-1:"-1",1:0)
Q
TS D FULL^VALM1 D EXP^DGJTEE1 G TSQ
TSQ D EVDT^DGJTEE S VALMBG=1,VALMBCK="R" Q
WARN K ^UTILITY("DGJTADM",$J)
S DGJTCNT=0 F I=0:0 S I=$O(^DGPM("ATID1",DFN,I)) Q:'I S IFN=$O(^(I,0)) I $D(^DGPM(IFN,0)),($P(^(0),"^",2)=1) S DGJTCNT=DGJTCNT+1,^UTILITY("DGJTADM",$J,DGJTCNT,IFN)=""
I '$D(^UTILITY("DGJTADM",$J)) W !!,*7," Patient has no admissions on file in this facility",! Q
K OK,I,PTF
Q
;
;
WR ;write node from delinquent records file
N X,Y
S X=$P(DGJT,"^",2)
W $S(X]""&($D(^VAS(393.3,+X,0))):$P(^VAS(393.3,+X,0),"^",1),1:"UNKNOWN DEFICIENCY")
S Y=$P(DGJT,"^",3) I Y]"" X ^DD("DD") W ?45,Y
Q
;
;
WARD ; -- find last ward for event driver
; input CA = ifn of cors adm
N IDT,MVT,M
S X=""
F IDT=0:0 S IDT=$O(^DGPM("APMV",DFN,CA,IDT)) Q:'IDT F MVT=0:0 S MVT=$O(^DGPM("APMV",DFN,CA,IDT,MVT)) Q:'MVT I $D(^DGPM(MVT,0)) S M=^(0) I "^13^43^44^45^"'[(U_$P(M,U,18)_U),$D(^DIC(42,+$P(M,U,6),0)) S X=+$P(M,U,6) G WARDQ
WARDQ Q
PHYDEF ;Cross-reference on the Date Transcribed,10.03; Transcribed By,10.04
; Date Signed,10.05; Signed By,10.06
;to update the Physician for Deficiency field (#.14)
;in the Incomplete Records Tracking file (#393)
N DGJX,DGJTNOD,DGJTDV,DGJTDN,DGJTPD,DGJNDT
S DGJTNOD=$G(^VAS(393,DA,0)),DGJTDV=$P(DGJTNOD,"^",6)
S DGJTDV=$G(^DG(40.8,DGJTDV,"DT"))
I $D(DGJATTD) I $P(DGJTNOD,"^",11)=$O(^DG(393.2,"B","TRANSCRIBED",0))&($P(DGJTDV,"^",10)="A")!($P(DGJTNOD,"^",11)=$O(^DG(393.2,"B","SIGNED",0))&($P(DGJTDV,"^",4)="A")) S DGJX=$P(DGJTNOD,"^",10) D SET K DGJATTD Q
S DGJTPD=$P(DGJTNOD,"^",14)
S DGJNDT=$G(^VAS(393,DA,"DT"))
I $D(DGJFDIC) D K DGJFDIC Q
.S DGJX=$S($P(DGJNDT,"^",2)]""&($P(DGJNDT,"^",1)]""):$P(DGJNDT,"^",2),$P(DGJTNOD,"^",12)]"":$P(DGJTNOD,"^",12),1:$P(DGJTNOD,"^",9)) D SET Q
I $D(DGJFSIG) D K DGJFSIG Q
.I $P(DGJNDT,"^",3)']""!($P(DGJNDT,"^",4)']"") S DGJX=$S($P(DGJNDT,"^",2)]"":$P(DGJNDT,"^",2),$P(DGJTNOD,"^",12)]"":$P(DGJTNOD,"^",12),1:$P(DGJTNOD,"^",9)) D SET Q
.S DGJX=$S($P(DGJTDV,"^",10)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",10)="A":$P(DGJTNOD,"^",10),1:"") Q:DGJX=DGJTPD D SET Q
I $D(DGJFREV) D K DGJFREV Q
.I $P(DGJNDT,"^",5)']""!($P(DGJNDT,"^",6)']"") I $P(DGJNDT,"^",2)]"" S DGJX=$S($P(DGJTDV,"^",10)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",10)="A":$P(DGJTNOD,"^",10),1:"") D SET Q
.I $P(DGJNDT,"^",5)']""!($P(DGJNDT,"^",6)']"") I $P(DGJNDT,"^",2)']"" S DGJX=$S($P(DGJTNOD,"^",12)]"":$P(DGJTNOD,"^",12),$P(DGJTNOD,"^",9)]"":$P(DGJTNOD,"^",9),1:"") D SET Q
.S DGJX=$S($P(DGJTDV,"^",3)=0:$P(DGJNDT,"^",6),$P(DGJTDV,"^",4)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",4)="A":$P(DGJTNOD,"^",10),1:"") D SET Q
I $D(DGJREVD) D K DGJREVD Q
.I $P(DGJNDT,"^",7)']""!($P(DGJNDT,"^",8)']"") S DGJX=$S($P(DGJTDV,"^",4)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",4)="A":$P(DGJTNOD,"^",10),1:"") D SET Q
.S DGJX=$S($P(DGJNDT,"^",7)]""&($P(DGJNDT,"^",8)]""):$P(DGJNDT,"^",8),$P(DGJTDV,"^",4)="P":$P(DGJTNOD,"^",9),$P(DGJTDV,"^",4)="A":$P(DGJTNOD,"^",10),1:"") D SET Q
Q
SET S $P(^VAS(393,DA,0),"^",14)=DGJX Q
Q K DGJTDV,DGJTDEL
QUIT K DA,DFN,DIC,DIE,DIR,DR,DTOUT,I,IFN,PTF,VAIP,DGA1,DGJC,DGJT,DGJTADN,DGJTAIFN,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,DGJTCH,DGJTCH1,DGJTFG,DGJTFL,DGJTDDT,DGJTF,VAINDT
K DIC("S"),DIC("A") Q
DGJTUTL ;ALB/MIR - ZSECUTABLE HELP FOR EVENT DATE IN INCOMPLETE RECORD FILE ; 04 JAN 91
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
+2 NEW DFN,I,J,OK,PTF
SET DFN=+^VAS(393,DA,0)
+3 DO WARN
+4 ;
+5 WRITE !,"Choose from:"
+6 FOR I=0:0
SET I=$ORDER(^UTILITY("DGJTADM",$JOB,I))
IF 'I
QUIT
SET Y=+^DGPM(I,0)
XECUTE ^DD("DD")
WRITE !?5,Y
+7 ;
PTF ;Check to make sure PTF exists and it is not closed
+1 SET OK=$SELECT('$DATA(^DGPT(+PTF)):0,$DATA(^DGP(45.84,+PTF)):0,1:1)
+2 QUIT
PHYSRTRG SET DGJTEST=$PIECE(^VAS(393,D0,0),"^",11)
SET X=$SELECT(DGJTEST=$ORDER(^DG(393.2,"B","TRANSCRIBED",0)):0,DGJTEST=$ORDER(^DG(393.2,"B","SIGNED",0)):0,DGJTEST=$ORDER(^DG(393.2,"B","REVIEWED",0)):0,1:1)
KILL DGJTEST
QUIT
LESS48 ;Checking for discharge summary less than 48 hours.
+1 IF $DATA(^VAS(393,DA,"DT"))
IF $PIECE(^("DT"),"^",1)]""
SET X=0
QUIT
+2 SET (DGJTX4,X1)=$PIECE(^DGPM(+$PIECE(DGJTNO,"^",4),0),"^",1)
SET DGJTX3=+$PIECE(DGJTNO,"^",3)
SET X2=2
DO C^%DTC
IF DGJTX3<X&($PIECE(DGJTNO,"^",3)>DGJTX4)
DO ASK
KILL DGJTX3,DGJTX4
+3 QUIT
ASK WRITE !!,"Will this Discharge Summary <48 hrs need to be dictated? "
+1 SET %=2
DO YN^DICN
IF '%
WRITE !,"ENTER:",!?10,"Y for YES",!?10,"N for NO",!?10,"^ to EXIT"
GOTO ASK
+2 SET X=$SELECT(%=2:1,%=-1:"-1",1:0)
+3 QUIT
TS DO FULL^VALM1
DO EXP^DGJTEE1
GOTO TSQ
TSQ DO EVDT^DGJTEE
SET VALMBG=1
SET VALMBCK="R"
QUIT
WARN KILL ^UTILITY("DGJTADM",$JOB)
+1 SET DGJTCNT=0
FOR I=0:0
SET I=$ORDER(^DGPM("ATID1",DFN,I))
IF 'I
QUIT
SET IFN=$ORDER(^(I,0))
IF $DATA(^DGPM(IFN,0))
IF ($PIECE(^(0),"^",2)=1)
SET DGJTCNT=DGJTCNT+1
SET ^UTILITY("DGJTADM",$JOB,DGJTCNT,IFN)=""
+2 IF '$DATA(^UTILITY("DGJTADM",$JOB))
WRITE !!,*7," Patient has no admissions on file in this facility",!
QUIT
+3 KILL OK,I,PTF
+4 QUIT
+5 ;
+6 ;
WR ;write node from delinquent records file
+1 NEW X,Y
+2 SET X=$PIECE(DGJT,"^",2)
+3 WRITE $SELECT(X]""&($DATA(^VAS(393.3,+X,0))):$PIECE(^VAS(393.3,+X,0),"^",1),1:"UNKNOWN DEFICIENCY")
+4 SET Y=$PIECE(DGJT,"^",3)
IF Y]""
XECUTE ^DD("DD")
WRITE ?45,Y
+5 QUIT
+6 ;
+7 ;
WARD ; -- find last ward for event driver
+1 ; input CA = ifn of cors adm
+2 NEW IDT,MVT,M
+3 SET X=""
+4 FOR IDT=0:0
SET IDT=$ORDER(^DGPM("APMV",DFN,CA,IDT))
IF 'IDT
QUIT
FOR MVT=0:0
SET MVT=$ORDER(^DGPM("APMV",DFN,CA,IDT,MVT))
IF 'MVT
QUIT
IF $DATA(^DGPM(MVT,0))
SET M=^(0)
IF "^13^43^44^45^"'[(U_$PIECE(M,U,18)_U)
IF $DATA(^DIC(42,+$PIECE(M,U,6),0))
SET X=+$PIECE(M,U,6)
GOTO WARDQ
WARDQ QUIT
PHYDEF ;Cross-reference on the Date Transcribed,10.03; Transcribed By,10.04
+1 ; Date Signed,10.05; Signed By,10.06
+2 ;to update the Physician for Deficiency field (#.14)
+3 ;in the Incomplete Records Tracking file (#393)
+4 NEW DGJX,DGJTNOD,DGJTDV,DGJTDN,DGJTPD,DGJNDT
+5 SET DGJTNOD=$GET(^VAS(393,DA,0))
SET DGJTDV=$PIECE(DGJTNOD,"^",6)
+6 SET DGJTDV=$GET(^DG(40.8,DGJTDV,"DT"))
+7 IF $DATA(DGJATTD)
IF $PIECE(DGJTNOD,"^",11)=$ORDER(^DG(393.2,"B","TRANSCRIBED",0))&($PIECE(DGJTDV,"^",10)="A")!($PIECE(DGJTNOD,"^",11)=$ORDER(^DG(393.2,"B","SIGNED",0))&($PIECE(DGJTDV,"^",4)="A"))
SET DGJX=$PIECE(DGJTNOD,"^",10)
DO SET
KILL DGJATTD
QUIT
+8 SET DGJTPD=$PIECE(DGJTNOD,"^",14)
+9 SET DGJNDT=$GET(^VAS(393,DA,"DT"))
+10 IF $DATA(DGJFDIC)
Begin DoDot:1
+11 SET DGJX=$SELECT($PIECE(DGJNDT,"^",2)]""&($PIECE(DGJNDT,"^",1)]""):$PIECE(DGJNDT,"^",2),$PIECE(DGJTNOD,"^",12)]"":$PIECE(DGJTNOD,"^",12),1:$PIECE(DGJTNOD,"^",9))
DO SET
QUIT
End DoDot:1
KILL DGJFDIC
QUIT
+12 IF $DATA(DGJFSIG)
Begin DoDot:1
+13 IF $PIECE(DGJNDT,"^",3)']""!($PIECE(DGJNDT,"^",4)']"")
SET DGJX=$SELECT($PIECE(DGJNDT,"^",2)]"":$PIECE(DGJNDT,"^",2),$PIECE(DGJTNOD,"^",12)]"":$PIECE(DGJTNOD,"^",12),1:$PIECE(DGJTNOD,"^",9))
DO SET
QUIT
+14 SET DGJX=$SELECT($PIECE(DGJTDV,"^",10)="P":$PIECE(DGJTNOD,"^",9),$PIECE(DGJTDV,"^",10)="A":$PIECE(DGJTNOD,"^",10),1:"")
IF DGJX=DGJTPD
QUIT
DO SET
QUIT
End DoDot:1
KILL DGJFSIG
QUIT
+15 IF $DATA(DGJFREV)
Begin DoDot:1
+16 IF $PIECE(DGJNDT,"^",5)']""!($PIECE(DGJNDT,"^",6)']"")
IF $PIECE(DGJNDT,"^",2)]""
SET DGJX=$SELECT($PIECE(DGJTDV,"^",10)="P":$PIECE(DGJTNOD,"^",9),$PIECE(DGJTDV,"^",10)="A":$PIECE(DGJTNOD,"^",10),1:"")
DO SET
QUIT
+17 IF $PIECE(DGJNDT,"^",5)']""!($PIECE(DGJNDT,"^",6)']"")
IF $PIECE(DGJNDT,"^",2)']""
SET DGJX=$SELECT($PIECE(DGJTNOD,"^",12)]"":$PIECE(DGJTNOD,"^",12),$PIECE(DGJTNOD,"^",9)]"":$PIECE(DGJTNOD,"^",9),1:"")
DO SET
QUIT
+18 SET DGJX=$SELECT($PIECE(DGJTDV,"^",3)=0:$PIECE(DGJNDT,"^",6),$PIECE(DGJTDV,"^",4)="P":$PIECE(DGJTNOD,"^",9),$PIECE(DGJTDV,"^",4)="A":$PIECE(DGJTNOD,"^",10),1:"")
DO SET
QUIT
End DoDot:1
KILL DGJFREV
QUIT
+19 IF $DATA(DGJREVD)
Begin DoDot:1
+20 IF $PIECE(DGJNDT,"^",7)']""!($PIECE(DGJNDT,"^",8)']"")
SET DGJX=$SELECT($PIECE(DGJTDV,"^",4)="P":$PIECE(DGJTNOD,"^",9),$PIECE(DGJTDV,"^",4)="A":$PIECE(DGJTNOD,"^",10),1:"")
DO SET
QUIT
+21 SET DGJX=$SELECT($PIECE(DGJNDT,"^",7)]""&($PIECE(DGJNDT,"^",8)]""):$PIECE(DGJNDT,"^",8),$PIECE(DGJTDV,"^",4)="P":$PIECE(DGJTNOD,"^",9),$PIECE(DGJTDV,"^",4)="A":$PIECE(DGJTNOD,"^",10),1:"")
DO SET
QUIT
End DoDot:1
KILL DGJREVD
QUIT
+22 QUIT
SET SET $PIECE(^VAS(393,DA,0),"^",14)=DGJX
QUIT
Q KILL DGJTDV,DGJTDEL
QUIT KILL DA,DFN,DIC,DIE,DIR,DR,DTOUT,I,IFN,PTF,VAIP,DGA1,DGJC,DGJT,DGJTADN,DGJTAIFN,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,DGJTCH,DGJTCH1,DGJTFG,DGJTFL,DGJTDDT,DGJTF,VAINDT
+2 KILL DIC("S"),DIC("A")
QUIT
