- DGJTVW3 ;ALB/MAF - DISPLAY SCREENS FOR DEFICIENCIES (LIST PROCESSOR) ; 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
- S RTE=DFN_";DPT(",RTYPE=1 D LATEST^RTUTL3
- K ^TMP("DGJRPT",$J)
- S X="",(VALMCNT,DGJCNT)=0,VALMBG=1
- S X=$$SETSTR^VALM1(DGJTHDR,X,25,$L(DGJTHDR)) D TMP
- S X=""
- S X=$$SETSTR^VALM1("1)",X,1,2)
- S X=$$SETSTR^VALM1("2)",X,42,2) D TMP
- S X=""
- S DGJVAL=$P(DGJTNO,"^",2) S DGJVAL=$S($D(^VAS(393.3,+DGJVAL,0)):$P(^VAS(393.3,+DGJVAL,0),"^",1),1:"")
- S X=$$SETSTR^VALM1(" *Type of Deficiency: ",X,1,22)
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- 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,42,21)
- S DGJVAL=$P(DGJTNO,"^",7) S DGJVAL=$S($D(^DIC(45.7,+DGJVAL,0)):$P(^(0),"^"),1:"")
- S X=$$SETSTR^VALM1(DGJVAL,X,64,17) D TMP
- S X=""
- S DGJVAL=" "_$S($P(DGJTNO,"^",2)=1&('$D(DGJTVIEW)):"*",1:" ")_"Event Date: "
- S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- S DGJVAL=$P(DGJTNO,"^",3),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- 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=$$SETSTR^VALM1(DGJVAL,X,42,21)
- S DGJVAL=$P(DGJTNO,"^",9) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
- S X=$$SETSTR^VALM1(DGJVAL,X,64,17) D TMP
- S X="",DGJVAL=" "_$S('$D(DGJTVIEW):"*",1:"")_"Admission: "
- S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- I $P(DGJTNO,"^",4)]"" S DGJVAL=$P(DGJTNO,"^",4) S Y=$S($D(^DGPM(+DGJVAL,0)):+^DGPM(DGJVAL,0),1:"") X ^DD("DD") S DGJVAL=Y
- I $P(DGJTNO,"^",4)']"" S DGJVAL="OUTPATIENT"
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- 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: "
- I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S X=$$SETSTR^VALM1(DGJVAL,X,42,21)
- 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,64,17) D TMP
- S X=""
- S X=$$SETSTR^VALM1(" *Division: ",X,1,22)
- S DGJVAL=$P(DGJTNO,"^",6) S DGJVAL=$S($D(^DG(40.8,+DGJVAL,0)):$P(^(0),"^",1),1:"")
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18) D TMP
- S DGJVAL=$P(DGJTNO,"^",5) S DGJVAL=$S($D(^SC(+DGJVAL,0)):$P(^(0),"^"),1:"")
- S DGJVAL=" "_$S($P(DGJTNO,"^",2)=1&('$D(DGJTVIEW)):"*",1:" ")_"Location: "
- S X=""
- S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- S DGJVAL=$P(DGJTNO,"^",5) S DGJVAL=$S($D(^SC(+DGJVAL,0)):$P(^(0),"^"),1:"")
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- S DGJVAL=$P(RTDATA,"^",2)
- S X=$$SETSTR^VALM1(" *Borrower: ",X,42,21)
- S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP
- S DGJVAL=$P(DGJTNO,"^",8)
- S DGJVAL=$S($D(^DG(393.1,+DGJVAL,0)):$P(^(0),"^",1),1:"")
- S X=""
- S X=$$SETSTR^VALM1(" *Service: ",X,1,22)
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- S DGJVAL=$P(RTDATA,"^",3)
- S X=$$SETSTR^VALM1(" *Phone/Rm: ",X,42,21)
- S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP
- S X=""
- S X=$$SETSTR^VALM1(" Phys. Responsible: ",X,1,22)
- S DGJVAL=$P(DGJTNO,"^",12) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
- 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(" *Date Charged: ",X,42,21)
- S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP
- K RTE,RTYPE,RTDATA
- D CODDT^DGJTVW,CODBY^DGJTVW
- S X=""
- S X=$$SETSTR^VALM1("3)",X,1,2) D TMP
- S X=""
- S X=$$SETSTR^VALM1(" Status: ",X,1,22)
- S DGJVAL=$P(DGJTNO,"^",11) S DGJVAL=$S($D(^DG(393.2,+DGJVAL,0)):$P(^DG(393.2,DGJVAL,0),"^",1),1:"NOT SPECIFIED")
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18) D TMP
- I '$D(^VAS(393,$P(DGJTEDT,"^",2),"MSG")) S X="",X=$$SETSTR^VALM1("4)",X,1,2) D TMP S X="",X=$$SETSTR^VALM1("Comments:",X,1,9) D TMP,DISP Q
- D COM^DGJTVW
- DISP S:'$D(DGJTVIEW) X="",X=$$SETSTR^VALM1("* For display only!",X,1,19) D:'$D(DGJTVIEW) TMP Q
- TMP S DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
- S ^TMP("DGJRPT",$J,DGJCNT,0)=X,^TMP("DGJRPT",$J,"IDX",VALMCNT,DGJCNT)=""
- S ^TMP("RPTIDX",$J,DGJCNT)=VALMCNT
- Q
- DGJTVW3 ;ALB/MAF - DISPLAY SCREENS FOR DEFICIENCIES (LIST PROCESSOR) ; 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 SET RTE=DFN_";DPT("
- SET RTYPE=1
- DO LATEST^RTUTL3
- +6 KILL ^TMP("DGJRPT",$JOB)
- +7 SET X=""
- SET (VALMCNT,DGJCNT)=0
- SET VALMBG=1
- +8 SET X=$$SETSTR^VALM1(DGJTHDR,X,25,$LENGTH(DGJTHDR))
- DO TMP
- +9 SET X=""
- +10 SET X=$$SETSTR^VALM1("1)",X,1,2)
- +11 SET X=$$SETSTR^VALM1("2)",X,42,2)
- DO TMP
- +12 SET X=""
- +13 SET DGJVAL=$PIECE(DGJTNO,"^",2)
- SET DGJVAL=$SELECT($DATA(^VAS(393.3,+DGJVAL,0)):$PIECE(^VAS(393.3,+DGJVAL,0),"^",1),1:"")
- +14 SET X=$$SETSTR^VALM1(" *Type of Deficiency: ",X,1,22)
- +15 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +16 SET DGJVAL=" "_$SELECT('$DATA(^XUSEC("DGJ TS UPDATE",DUZ))&($PIECE(DGJTNO,"^",2)=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$DATA(DGJTVIEW)):"*",1:" ")_"Specialty: "
- +17 SET X=$$SETSTR^VALM1(DGJVAL,X,42,21)
- +18 SET DGJVAL=$PIECE(DGJTNO,"^",7)
- SET DGJVAL=$SELECT($DATA(^DIC(45.7,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +19 SET X=$$SETSTR^VALM1(DGJVAL,X,64,17)
- DO TMP
- +20 SET X=""
- +21 SET DGJVAL=" "_$SELECT($PIECE(DGJTNO,"^",2)=1&('$DATA(DGJTVIEW)):"*",1:" ")_"Event Date: "
- +22 SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- +23 SET DGJVAL=$PIECE(DGJTNO,"^",3)
- SET Y=DGJVAL
- IF DGJVAL]""
- XECUTE ^DD("DD")
- SET DGJVAL=Y
- +24 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +25 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: "
- +26 SET X=$$SETSTR^VALM1(DGJVAL,X,42,21)
- +27 SET DGJVAL=$PIECE(DGJTNO,"^",9)
- SET DGJVAL=$SELECT($DATA(^VA(200,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +28 SET X=$$SETSTR^VALM1(DGJVAL,X,64,17)
- DO TMP
- +29 SET X=""
- SET DGJVAL=" "_$SELECT('$DATA(DGJTVIEW):"*",1:"")_"Admission: "
- +30 SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- +31 IF $PIECE(DGJTNO,"^",4)]""
- SET DGJVAL=$PIECE(DGJTNO,"^",4)
- SET Y=$SELECT($DATA(^DGPM(+DGJVAL,0)):+^DGPM(DGJVAL,0),1:"")
- XECUTE ^DD("DD")
- SET DGJVAL=Y
- +32 IF $PIECE(DGJTNO,"^",4)']""
- SET DGJVAL="OUTPATIENT"
- +33 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +34 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: "
- +35 IF $PIECE(DGJTDEL,"^",3)=1!($PIECE(DGJTDEL,"^",3)=0&($PIECE(DGJTDEL,"^",10)="A"))
- SET X=$$SETSTR^VALM1(DGJVAL,X,42,21)
- +36 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:"")
- +37 IF $PIECE(DGJTDEL,"^",3)=1!($PIECE(DGJTDEL,"^",3)=0&($PIECE(DGJTDEL,"^",10)="A"))
- SET X=$$SETSTR^VALM1(DGJVAL,X,64,17)
- DO TMP
- +38 SET X=""
- +39 SET X=$$SETSTR^VALM1(" *Division: ",X,1,22)
- +40 SET DGJVAL=$PIECE(DGJTNO,"^",6)
- SET DGJVAL=$SELECT($DATA(^DG(40.8,+DGJVAL,0)):$PIECE(^(0),"^",1),1:"")
- +41 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- DO TMP
- +42 SET DGJVAL=$PIECE(DGJTNO,"^",5)
- SET DGJVAL=$SELECT($DATA(^SC(+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +43 SET DGJVAL=" "_$SELECT($PIECE(DGJTNO,"^",2)=1&('$DATA(DGJTVIEW)):"*",1:" ")_"Location: "
- +44 SET X=""
- +45 SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- +46 SET DGJVAL=$PIECE(DGJTNO,"^",5)
- SET DGJVAL=$SELECT($DATA(^SC(+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +47 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +48 SET DGJVAL=$PIECE(RTDATA,"^",2)
- +49 SET X=$$SETSTR^VALM1(" *Borrower: ",X,42,21)
- +50 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +51 SET DGJVAL=$PIECE(DGJTNO,"^",8)
- +52 SET DGJVAL=$SELECT($DATA(^DG(393.1,+DGJVAL,0)):$PIECE(^(0),"^",1),1:"")
- +53 SET X=""
- +54 SET X=$$SETSTR^VALM1(" *Service: ",X,1,22)
- +55 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +56 SET DGJVAL=$PIECE(RTDATA,"^",3)
- +57 SET X=$$SETSTR^VALM1(" *Phone/Rm: ",X,42,21)
- +58 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +59 SET X=""
- +60 SET X=$$SETSTR^VALM1(" Phys. Responsible: ",X,1,22)
- +61 SET DGJVAL=$PIECE(DGJTNO,"^",12)
- SET DGJVAL=$SELECT($DATA(^VA(200,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +62 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +63 SET DGJVAL=$PIECE(RTDATA,"^",4)
- SET Y=DGJVAL
- IF DGJVAL]""
- XECUTE ^DD("DD")
- SET DGJVAL=Y
- +64 SET X=$$SETSTR^VALM1(" *Date Charged: ",X,42,21)
- +65 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +66 KILL RTE,RTYPE,RTDATA
- +67 DO CODDT^DGJTVW
- DO CODBY^DGJTVW
- +68 SET X=""
- +69 SET X=$$SETSTR^VALM1("3)",X,1,2)
- DO TMP
- +70 SET X=""
- +71 SET X=$$SETSTR^VALM1(" Status: ",X,1,22)
- +72 SET DGJVAL=$PIECE(DGJTNO,"^",11)
- SET DGJVAL=$SELECT($DATA(^DG(393.2,+DGJVAL,0)):$PIECE(^DG(393.2,DGJVAL,0),"^",1),1:"NOT SPECIFIED")
- +73 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- DO TMP
- +74 IF '$DATA(^VAS(393,$PIECE(DGJTEDT,"^",2),"MSG"))
- SET X=""
- SET X=$$SETSTR^VALM1("4)",X,1,2)
- DO TMP
- SET X=""
- SET X=$$SETSTR^VALM1("Comments:",X,1,9)
- DO TMP
- DO DISP
- QUIT
- +75 DO COM^DGJTVW
- DISP IF '$DATA(DGJTVIEW)
- SET X=""
- SET X=$$SETSTR^VALM1("* For display only!",X,1,19)
- IF '$DATA(DGJTVIEW)
- DO TMP
- QUIT
- TMP SET DGJCNT=DGJCNT+1
- SET VALMCNT=VALMCNT+1
- +1 SET ^TMP("DGJRPT",$JOB,DGJCNT,0)=X
- SET ^TMP("DGJRPT",$JOB,"IDX",VALMCNT,DGJCNT)=""
- +2 SET ^TMP("RPTIDX",$JOB,DGJCNT)=VALMCNT
- +3 QUIT
