- DGJTVW1 ;ALB/MAF - DISPLAY SCREENS FOR INCOMPLETE RECORDS TRACKING (LIST PROCESSOR) CONT. ; SEP 31,1992@900
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- 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=1 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"
- DGJTVW1 ;ALB/MAF - DISPLAY SCREENS FOR INCOMPLETE RECORDS TRACKING (LIST PROCESSOR) CONT. ; SEP 31,1992@900
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- 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=1
- 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"
