DGJTVW1 ;ALB/MAF - DISPLAY SCREENS FOR INCOMPLETE RECORDS TRACKING (LIST PROCESSOR) CONT. ; SEP 31,1992@900
;;1.0;Incomplete Records Tracking;;Jun 25, 2001
EN Q:'$D(^VAS(393,+$P(DGJTEDT,"^",2),0)) S DGJTNO=^VAS(393,$P(DGJTEDT,"^",2),0),DFN=+DGJTNO
I $D(^VAS(393,$P(DGJTEDT,"^",2),"DT")) S DGJTNDT=^VAS(393,$P(DGJTEDT,"^",2),"DT")
I '$D(^VAS(393,$P(DGJTEDT,"^",2),"DT")) S DGJTNDT="^^^^^^^^^^"
S X=$P(^VAS(393,$P(DGJTEDT,"^",2),0),"^",6) S DGJTDEL=$S($D(^DG(40.8,+X,"DT")):^("DT"),1:DGJTDEL)
S DGJTFL=0,DGJTHDR="INCOMPLETE RECORDS TRACKING "_$S($D(DGJTVIEW):"<View>",1:"<Edit>"),$P(DGJTCL,"=",81)="",DGJTNM=$P(^DPT(+DGJTNO,0),"^",1) D PID^VADPT6 S DGJTPTID=VA("PID") K VA
D ^DGJTVW2
S RTE=DFN_";DPT(",RTYPE=$$RECTYP^DGJOPRT1(DGJTNO) D LATEST^RTUTL3
S X=""
S DGJVAL=" "_$S('$D(^XUSEC("DGJ TS UPDATE",DUZ))&($P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$D(DGJTVIEW)):"*",1:" ")_"Specialty: "
S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
S DGJVAL=$P(DGJTNO,"^",7) S DGJVAL=$S($D(^DIC(45.7,+DGJVAL,0)):$P(^(0),"^"),1:"")
S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
S DGJVAL=$P(RTDATA,"^",2)
S X=$$SETSTR^VALM1($S($D(DGJTVIEW):" Borrower: ",1:" *Borrower: "),X,42,21)
S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP^DGJTVW2
S DGJVAL=" "_$S('$D(^XUSEC("DGJ TS UPDATE",DUZ))&($P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$D(DGJTVIEW)):"*",1:" ")_"Primary Physician: "
S X=""
S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
S DGJVAL=$P(DGJTNO,"^",9) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
S DGJVAL=$P(RTDATA,"^",3)
S X=$$SETSTR^VALM1($S($D(DGJTVIEW):" Phone/Rm: ",1:" *Phone/Rm: "),X,42,21)
S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP^DGJTVW2
I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S DGJVAL=$S('$D(^XUSEC("DGJ TS UPDATE",DUZ))&($P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$D(DGJTVIEW)):"*",1:" ")_"Attending Physician: "
S X=""
I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S DGJVAL=$P(DGJTNO,"^",10) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
S DGJVAL=$P(RTDATA,"^",4),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y
S X=$$SETSTR^VALM1($S($D(DGJTVIEW):" Date Charged: ",1:" *Date Charged: "),X,42,21)
S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP^DGJTVW2
K RTDATA,RTE,RTYPE
D CODDT^DGJTVW,CODBY^DGJTVW
I '$D(^VAS(393,$P(DGJTEDT,"^",2),"MSG")) S X="",X=$$SETSTR^VALM1("4)",X,1,2) D TMP^DGJTVW2 S X="",X=$$SETSTR^VALM1("Comments:",X,1,9) D TMP^DGJTVW2 G STAT
D COM^DGJTVW
STAT S:'$D(DGJTVIEW) X="",X=$$SETSTR^VALM1("* For display only!",X,1,19) D:'$D(DGJTVIEW) TMP^DGJTVW2
D STAT1^DGJTVW
K DGJTSF
I $D(DGJTVIEW) K DGJTVIEW Q
Q
REDSP S VALMBCK="R" D EN Q
ALLEDIT ;Edit all 4 groups
I $P(DGJTNO,"^",2)'=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) F DGJTNUM=1:1:4 S:DGJTNUM=3 X=3 D EDIT Q:'$D(DGJTUP)!(X="^")!($D(DTOUT)) K DGJTUP
I $P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) F DGJTNUM=1,3,4,2 S:DGJTNUM=3 X=3 D EDIT Q:'$D(DGJTUP)!(X="^")!($D(DTOUT)) K DGJTUP
Q
EDIT ;EDIT
D FULL^VALM1
I DGJTNUM["2",$P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) D CK,EN S VALMBCK="R" Q
D EDIT1
D:'$D(DGJTDEF) EN D:$D(DGJTDEF) ^DGJTVW3 S VALMBCK="R" Q
QUIT1 K %,D,DA,D0,DIE,DR,VA,DGJT1,DGJTCL,DGJTEDT,DGJTHDR,DGJTNDT,DGJTNM,DGJTNO,DGJTNST,DGJTNUM,DGJTNUM1,DGJTPTID,DGJTRC,DGJTUP,DGJTXX,DGJX,DGX,DGJTYPX,Y,^TMP("DGJRPT",$J),^TMP("RPTIDX",$J) Q
DISTS S DGPMT=6,DGPMCA=$P(DGJTNO,"^",4) D CA^DGPMV S:Y]"" DGJTUP=1 Q:$D(DGJTSEDT) D STAT1^DGJTVW Q
CK S DGJTNUM1=DGJTNUM I DGJTNUM["1" S DGJTNUM=1 D EDIT1 S DGJTNUM=DGJTNUM1 Q:'$D(DGJTUP) K DGJTUP
I '$D(^XUSEC("DGJ TS UPDATE",DUZ)) W !!,"A security key must be issued to edit data in item 2." R !!,"Hit return to continue ",X:DTIME Q:X="^"!('$T) G CK1
S DGJT1=2 D 1^DGJTVW
I DGJVAL]"" S Y=X X ^DD("DD") W !!,"PTF Record was closed on "_Y_" for patient.... You Must",!,"reopen the record before you can enter any changes for group 2",! S DGJTNUM1=DGJTNUM R !!,"Hit return to continue ",X:DTIME Q:X="^"!('$T) G CK1
I DGJTNUM1[2 D MESS S DGJTNUM=2 D DISTS S DGJTNUM=DGJTNUM1 Q:'$D(DGJTUP)
CK1 I DGJTNUM1[3 S DGJTNUM=3 D EDIT1 Q:'$D(DGJTUP) K DGJTUP
S DGJTNUM=DGJTNUM1 I DGJTNUM1[4 S DGJTNUM=4 D EDIT1 S DGJTNUM=DGJTNUM1
Q
EDIT1 S DIE="^VAS(393,",DA=$P(DGJTEDT,"^",2),DR="[DGJ EDIT IRT RECORD]" D ^DIE K DR,DIC("S")
K DR Q
MESS W !!?3,"When editing this section you must edit/create a new Treating Specialty"
W !,"Entering '^' at any prompt will exit you out of the "
W "treating Specialty edit only"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJTVW1 4847 printed Dec 13, 2024@02:00:59 Page 2
DGJTVW1 ;ALB/MAF - DISPLAY SCREENS FOR INCOMPLETE RECORDS TRACKING (LIST PROCESSOR) CONT. ; SEP 31,1992@900
+1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
EN if '$DATA(^VAS(393,+$PIECE(DGJTEDT,"^",2),0))
QUIT
SET DGJTNO=^VAS(393,$PIECE(DGJTEDT,"^",2),0)
SET DFN=+DGJTNO
+1 IF $DATA(^VAS(393,$PIECE(DGJTEDT,"^",2),"DT"))
SET DGJTNDT=^VAS(393,$PIECE(DGJTEDT,"^",2),"DT")
+2 IF '$DATA(^VAS(393,$PIECE(DGJTEDT,"^",2),"DT"))
SET DGJTNDT="^^^^^^^^^^"
+3 SET X=$PIECE(^VAS(393,$PIECE(DGJTEDT,"^",2),0),"^",6)
SET DGJTDEL=$SELECT($DATA(^DG(40.8,+X,"DT")):^("DT"),1:DGJTDEL)
+4 SET DGJTFL=0
SET DGJTHDR="INCOMPLETE RECORDS TRACKING "_$SELECT($DATA(DGJTVIEW):"<View>",1:"<Edit>")
SET $PIECE(DGJTCL,"=",81)=""
SET DGJTNM=$PIECE(^DPT(+DGJTNO,0),"^",1)
DO PID^VADPT6
SET DGJTPTID=VA("PID")
KILL VA
+5 DO ^DGJTVW2
+6 SET RTE=DFN_";DPT("
SET RTYPE=$$RECTYP^DGJOPRT1(DGJTNO)
DO LATEST^RTUTL3
+7 SET X=""
+8 SET DGJVAL=" "_$SELECT('$DATA(^XUSEC("DGJ TS UPDATE",DUZ))&($PIECE(DGJTNO,"^",2)=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$DATA(DGJTVIEW)):"*",1:" ")_"Specialty: "
+9 SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
+10 SET DGJVAL=$PIECE(DGJTNO,"^",7)
SET DGJVAL=$SELECT($DATA(^DIC(45.7,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
+11 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
+12 SET DGJVAL=$PIECE(RTDATA,"^",2)
+13 SET X=$$SETSTR^VALM1($SELECT($DATA(DGJTVIEW):" Borrower: ",1:" *Borrower: "),X,42,21)
+14 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
DO TMP^DGJTVW2
+15 SET DGJVAL=" "_$SELECT('$DATA(^XUSEC("DGJ TS UPDATE",DUZ))&($PIECE(DGJTNO,"^",2)=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$DATA(DGJTVIEW)):"*",1:" ")_"Primary Physician: "
+16 SET X=""
+17 SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
+18 SET DGJVAL=$PIECE(DGJTNO,"^",9)
SET DGJVAL=$SELECT($DATA(^VA(200,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
+19 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
+20 SET DGJVAL=$PIECE(RTDATA,"^",3)
+21 SET X=$$SETSTR^VALM1($SELECT($DATA(DGJTVIEW):" Phone/Rm: ",1:" *Phone/Rm: "),X,42,21)
+22 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
DO TMP^DGJTVW2
+23 IF $PIECE(DGJTDEL,"^",3)=1!($PIECE(DGJTDEL,"^",3)=0&($PIECE(DGJTDEL,"^",10)="A"))
SET DGJVAL=$SELECT('$DATA(^XUSEC("DGJ TS UPDATE",DUZ))&($PIECE(DGJTNO,"^",2)=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$DATA(DGJTVIEW)):"*",1:" ")_"Attending Physician: "
+24 SET X=""
+25 IF $PIECE(DGJTDEL,"^",3)=1!($PIECE(DGJTDEL,"^",3)=0&($PIECE(DGJTDEL,"^",10)="A"))
SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
+26 IF $PIECE(DGJTDEL,"^",3)=1!($PIECE(DGJTDEL,"^",3)=0&($PIECE(DGJTDEL,"^",10)="A"))
SET DGJVAL=$PIECE(DGJTNO,"^",10)
SET DGJVAL=$SELECT($DATA(^VA(200,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
+27 IF $PIECE(DGJTDEL,"^",3)=1!($PIECE(DGJTDEL,"^",3)=0&($PIECE(DGJTDEL,"^",10)="A"))
SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
+28 SET DGJVAL=$PIECE(RTDATA,"^",4)
SET Y=DGJVAL
IF DGJVAL]""
XECUTE ^DD("DD")
SET DGJVAL=Y
+29 SET X=$$SETSTR^VALM1($SELECT($DATA(DGJTVIEW):" Date Charged: ",1:" *Date Charged: "),X,42,21)
+30 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
DO TMP^DGJTVW2
+31 KILL RTDATA,RTE,RTYPE
+32 DO CODDT^DGJTVW
DO CODBY^DGJTVW
+33 IF '$DATA(^VAS(393,$PIECE(DGJTEDT,"^",2),"MSG"))
SET X=""
SET X=$$SETSTR^VALM1("4)",X,1,2)
DO TMP^DGJTVW2
SET X=""
SET X=$$SETSTR^VALM1("Comments:",X,1,9)
DO TMP^DGJTVW2
GOTO STAT
+34 DO COM^DGJTVW
STAT if '$DATA(DGJTVIEW)
SET X=""
SET X=$$SETSTR^VALM1("* For display only!",X,1,19)
if '$DATA(DGJTVIEW)
DO TMP^DGJTVW2
+1 DO STAT1^DGJTVW
+2 KILL DGJTSF
+3 IF $DATA(DGJTVIEW)
KILL DGJTVIEW
QUIT
+4 QUIT
REDSP SET VALMBCK="R"
DO EN
QUIT
ALLEDIT ;Edit all 4 groups
+1 IF $PIECE(DGJTNO,"^",2)'=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))
FOR DGJTNUM=1:1:4
if DGJTNUM=3
SET X=3
DO EDIT
if '$DATA(DGJTUP)!(X="^")!($DATA(DTOUT))
QUIT
KILL DGJTUP
+2 IF $PIECE(DGJTNO,"^",2)=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))
FOR DGJTNUM=1,3,4,2
if DGJTNUM=3
SET X=3
DO EDIT
if '$DATA(DGJTUP)!(X="^")!($DATA(DTOUT))
QUIT
KILL DGJTUP
+3 QUIT
EDIT ;EDIT
+1 DO FULL^VALM1
+2 IF DGJTNUM["2"
IF $PIECE(DGJTNO,"^",2)=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))
DO CK
DO EN
SET VALMBCK="R"
QUIT
+3 DO EDIT1
+4 if '$DATA(DGJTDEF)
DO EN
if $DATA(DGJTDEF)
DO ^DGJTVW3
SET VALMBCK="R"
QUIT
QUIT1 KILL %,D,DA,D0,DIE,DR,VA,DGJT1,DGJTCL,DGJTEDT,DGJTHDR,DGJTNDT,DGJTNM,DGJTNO,DGJTNST,DGJTNUM,DGJTNUM1,DGJTPTID,DGJTRC,DGJTUP,DGJTXX,DGJX,DGX,DGJTYPX,Y,^TMP("DGJRPT",$JOB),^TMP("RPTIDX",$JOB)
QUIT
DISTS SET DGPMT=6
SET DGPMCA=$PIECE(DGJTNO,"^",4)
DO CA^DGPMV
if Y]""
SET DGJTUP=1
if $DATA(DGJTSEDT)
QUIT
DO STAT1^DGJTVW
QUIT
CK SET DGJTNUM1=DGJTNUM
IF DGJTNUM["1"
SET DGJTNUM=1
DO EDIT1
SET DGJTNUM=DGJTNUM1
if '$DATA(DGJTUP)
QUIT
KILL DGJTUP
+1 IF '$DATA(^XUSEC("DGJ TS UPDATE",DUZ))
WRITE !!,"A security key must be issued to edit data in item 2."
READ !!,"Hit return to continue ",X:DTIME
if X="^"!('$TEST)
QUIT
GOTO CK1
+2 SET DGJT1=2
DO 1^DGJTVW
+3 IF DGJVAL]""
SET Y=X
XECUTE ^DD("DD")
WRITE !!,"PTF Record was closed on "_Y_" for patient.... You Must",!,"reopen the record before you can enter any changes for group 2",!
SET DGJTNUM1=DGJTNUM
READ !!,"Hit return to continue ",X:DTIME
if X="^"!('$TEST)
QUIT
GOTO CK1
+4 IF DGJTNUM1[2
DO MESS
SET DGJTNUM=2
DO DISTS
SET DGJTNUM=DGJTNUM1
if '$DATA(DGJTUP)
QUIT
CK1 IF DGJTNUM1[3
SET DGJTNUM=3
DO EDIT1
if '$DATA(DGJTUP)
QUIT
KILL DGJTUP
+1 SET DGJTNUM=DGJTNUM1
IF DGJTNUM1[4
SET DGJTNUM=4
DO EDIT1
SET DGJTNUM=DGJTNUM1
+2 QUIT
EDIT1 SET DIE="^VAS(393,"
SET DA=$PIECE(DGJTEDT,"^",2)
SET DR="[DGJ EDIT IRT RECORD]"
DO ^DIE
KILL DR,DIC("S")
+1 KILL DR
QUIT
MESS WRITE !!?3,"When editing this section you must edit/create a new Treating Specialty"
+1 WRITE !,"Entering '^' at any prompt will exit you out of the "
+2 WRITE "treating Specialty edit only"
