- DGJTVW2 ;ALB/MAF - DISPLAY SCREENS FOR INCOMPLETE RECORDS TRACKING (LIST PROCESSOR) CONT. ; SEP 31,1992@900
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- 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("3)",X,42,2) D TMP
- S X=""
- S DGJVAL=$P(DGJTNO,"^",2) S DGJVAL=$S($D(^VAS(393.3,DGJVAL,0)):$P(^(0),"^",1),1:"")
- I DGJVAL="DISCHARGE SUMMARY" 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) S DGJVAL="DISCHARGE SUM <48" S DGJTSF=1 K DGJTX3,DGJTX4
- S X=$$SETSTR^VALM1(" *Type of Report: ",X,1,22)
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- S DGJVAL=$P(DGJTNDT,"^",1),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y
- I $D(DGJTSF),DGJVAL']"",$P(DGJTNDT,"^",5)]"" D SFRM
- S X=$$SETSTR^VALM1(" Date Dictated: ",X,42,21)
- S X=$$SETSTR^VALM1(DGJVAL,X,63,18) 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=$P(DGJTNDT,"^",2) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
- I $D(DGJTSF),DGJVAL']"",$P(DGJTNDT,"^",5)]"" D SFRM
- S X=$$SETSTR^VALM1(" Dictated By: ",X,42,21)
- S X=$$SETSTR^VALM1(DGJVAL,X,63,18) 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)
- S X=$$SETSTR^VALM1(" Date Transcribed: ",X,42,21)
- S DGJVAL=$P(DGJTNDT,"^",3),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y
- I $D(DGJTSF),DGJVAL']"",$P(DGJTNDT,"^",1)']"",$P(DGJTNDT,"^",5)]"" D SFRM
- S X=$$SETSTR^VALM1(DGJVAL,X,63,18) 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)
- S Y=$P(DGJTNDT,"^",4),C=$P(^DD(393,10.04,0),"^",2) D Y^DIQ K C S DGJVAL=Y
- I $D(DGJTSF),DGJVAL']"",$P(DGJTNDT,"^",1)']"",$P(DGJTNDT,"^",5)]"" D SFRM
- S X=$$SETSTR^VALM1(" Transcribed By: ",X,42,21)
- S X=$$SETSTR^VALM1(DGJVAL,X,63,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 X=$$SETSTR^VALM1(" Date Signed: ",X,42,21)
- S DGJVAL=$P(DGJTNDT,"^",5),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y
- 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(DGJTNO,"^",8)
- S DGJVAL=$S($D(^DG(393.1,+DGJVAL,0)):$P(^(0),"^",1),1:"")
- S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- S DGJVAL=$P(DGJTNDT,"^",6) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
- S X=$$SETSTR^VALM1(" Signed By: ",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)
- I $P(DGJTDEL,"^",3)=1 S X=$$SETSTR^VALM1(" Date Reviewed: ",X,42,21)
- I $P(DGJTDEL,"^",3)=1 S DGJVAL=$P(DGJTNDT,"^",7),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y S X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- D TMP
- S DGJVAL=$P(DGJTNDT,"^",8) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
- S X=""
- I $P(DGJTDEL,"^",3)=1 S X=$$SETSTR^VALM1(" Reviewed By: ",X,42,21),X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP
- S X=""
- S X=$$SETSTR^VALM1("2)",X,1,2) D 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
- SFRM S DGJVAL="NOT APPLICABLE"
- Q
- DGJTVW2 ;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
- +2 KILL ^TMP("DGJRPT",$JOB)
- +3 SET X=""
- SET (VALMCNT,DGJCNT)=0
- SET VALMBG=1
- +4 SET X=$$SETSTR^VALM1(DGJTHDR,X,25,$LENGTH(DGJTHDR))
- DO TMP
- +5 SET X=""
- +6 SET X=$$SETSTR^VALM1("1)",X,1,2)
- +7 SET X=$$SETSTR^VALM1("3)",X,42,2)
- DO TMP
- +8 SET X=""
- +9 SET DGJVAL=$PIECE(DGJTNO,"^",2)
- SET DGJVAL=$SELECT($DATA(^VAS(393.3,DGJVAL,0)):$PIECE(^(0),"^",1),1:"")
- +10 IF DGJVAL="DISCHARGE SUMMARY"
- 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)
- SET DGJVAL="DISCHARGE SUM <48"
- SET DGJTSF=1
- KILL DGJTX3,DGJTX4
- +11 SET X=$$SETSTR^VALM1(" *Type of Report: ",X,1,22)
- +12 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +13 SET DGJVAL=$PIECE(DGJTNDT,"^",1)
- SET Y=DGJVAL
- IF DGJVAL]""
- XECUTE ^DD("DD")
- SET DGJVAL=Y
- +14 IF $DATA(DGJTSF)
- IF DGJVAL']""
- IF $PIECE(DGJTNDT,"^",5)]""
- DO SFRM
- +15 SET X=$$SETSTR^VALM1(" Date Dictated: ",X,42,21)
- +16 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +17 SET X=""
- +18 SET DGJVAL=" "_$SELECT($PIECE(DGJTNO,"^",2)=1&('$DATA(DGJTVIEW)):"*",1:" ")_"Event Date: "
- +19 SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- +20 SET DGJVAL=$PIECE(DGJTNO,"^",3)
- SET Y=DGJVAL
- IF DGJVAL]""
- XECUTE ^DD("DD")
- SET DGJVAL=Y
- +21 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +22 SET DGJVAL=$PIECE(DGJTNDT,"^",2)
- SET DGJVAL=$SELECT($DATA(^VA(200,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +23 IF $DATA(DGJTSF)
- IF DGJVAL']""
- IF $PIECE(DGJTNDT,"^",5)]""
- DO SFRM
- +24 SET X=$$SETSTR^VALM1(" Dictated By: ",X,42,21)
- +25 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +26 SET X=""
- SET DGJVAL=" "_$SELECT('$DATA(DGJTVIEW):"*",1:"")_"Admission: "
- +27 SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- +28 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
- +29 IF $PIECE(DGJTNO,"^",4)']""
- SET DGJVAL="OUTPATIENT"
- +30 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +31 SET X=$$SETSTR^VALM1(" Date Transcribed: ",X,42,21)
- +32 SET DGJVAL=$PIECE(DGJTNDT,"^",3)
- SET Y=DGJVAL
- IF DGJVAL]""
- XECUTE ^DD("DD")
- SET DGJVAL=Y
- +33 IF $DATA(DGJTSF)
- IF DGJVAL']""
- IF $PIECE(DGJTNDT,"^",1)']""
- IF $PIECE(DGJTNDT,"^",5)]""
- DO SFRM
- +34 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +35 SET X=""
- +36 SET X=$$SETSTR^VALM1(" *Division: ",X,1,22)
- +37 SET DGJVAL=$PIECE(DGJTNO,"^",6)
- SET DGJVAL=$SELECT($DATA(^DG(40.8,+DGJVAL,0)):$PIECE(^(0),"^",1),1:"")
- +38 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +39 SET Y=$PIECE(DGJTNDT,"^",4)
- SET C=$PIECE(^DD(393,10.04,0),"^",2)
- DO Y^DIQ
- KILL C
- SET DGJVAL=Y
- +40 IF $DATA(DGJTSF)
- IF DGJVAL']""
- IF $PIECE(DGJTNDT,"^",1)']""
- IF $PIECE(DGJTNDT,"^",5)]""
- DO SFRM
- +41 SET X=$$SETSTR^VALM1(" Transcribed By: ",X,42,21)
- +42 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +43 SET DGJVAL=$PIECE(DGJTNO,"^",5)
- SET DGJVAL=$SELECT($DATA(^SC(+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +44 SET DGJVAL=" "_$SELECT($PIECE(DGJTNO,"^",2)=1&('$DATA(DGJTVIEW)):"*",1:" ")_"Location: "
- +45 SET X=""
- +46 SET X=$$SETSTR^VALM1(DGJVAL,X,1,22)
- +47 SET DGJVAL=$PIECE(DGJTNO,"^",5)
- SET DGJVAL=$SELECT($DATA(^SC(+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +48 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +49 SET X=$$SETSTR^VALM1(" Date Signed: ",X,42,21)
- +50 SET DGJVAL=$PIECE(DGJTNDT,"^",5)
- SET Y=DGJVAL
- IF DGJVAL]""
- XECUTE ^DD("DD")
- SET DGJVAL=Y
- +51 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +52 SET DGJVAL=$PIECE(DGJTNO,"^",8)
- +53 SET DGJVAL=$SELECT($DATA(^DG(393.1,+DGJVAL,0)):$PIECE(^(0),"^",1),1:"")
- +54 SET X=""
- +55 SET X=$$SETSTR^VALM1(" *Service: ",X,1,22)
- +56 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +57 SET DGJVAL=$PIECE(DGJTNO,"^",8)
- +58 SET DGJVAL=$SELECT($DATA(^DG(393.1,+DGJVAL,0)):$PIECE(^(0),"^",1),1:"")
- +59 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +60 SET DGJVAL=$PIECE(DGJTNDT,"^",6)
- SET DGJVAL=$SELECT($DATA(^VA(200,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +61 SET X=$$SETSTR^VALM1(" Signed By: ",X,42,21)
- +62 SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +63 SET X=""
- +64 SET X=$$SETSTR^VALM1(" Phys. Responsible: ",X,1,22)
- +65 SET DGJVAL=$PIECE(DGJTNO,"^",12)
- SET DGJVAL=$SELECT($DATA(^VA(200,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +66 SET X=$$SETSTR^VALM1(DGJVAL,X,23,18)
- +67 IF $PIECE(DGJTDEL,"^",3)=1
- SET X=$$SETSTR^VALM1(" Date Reviewed: ",X,42,21)
- +68 IF $PIECE(DGJTDEL,"^",3)=1
- SET DGJVAL=$PIECE(DGJTNDT,"^",7)
- SET Y=DGJVAL
- IF DGJVAL]""
- XECUTE ^DD("DD")
- SET DGJVAL=Y
- SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- +69 DO TMP
- +70 SET DGJVAL=$PIECE(DGJTNDT,"^",8)
- SET DGJVAL=$SELECT($DATA(^VA(200,+DGJVAL,0)):$PIECE(^(0),"^"),1:"")
- +71 SET X=""
- +72 IF $PIECE(DGJTDEL,"^",3)=1
- SET X=$$SETSTR^VALM1(" Reviewed By: ",X,42,21)
- SET X=$$SETSTR^VALM1(DGJVAL,X,63,18)
- DO TMP
- +73 SET X=""
- +74 SET X=$$SETSTR^VALM1("2)",X,1,2)
- DO TMP
- +75 QUIT
- +76 ;
- +77 ;
- 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
- SFRM SET DGJVAL="NOT APPLICABLE"
- +1 QUIT
