DGJOTP1 ;MAF/ALB - TRANS PROD REPORT CONT. 1 ; SEP 11 1991@10:00
;;1.0;Incomplete Records Tracking;;Jun 25, 2001
;
I $D(DGJTMUL),DGJTMUL D DIVISION^VAUTOMA G:Y=-1 QUIT
I 'DGJTMUL S DGJTDV=$O(^DG(40.8,0))
D @(DGJTL) G:Y=-1 QUIT
D DAT^DGJOTP G:Y=-1 QUIT
S DIC("S")="I $S(""^OP REPORT^INTERIM SUMMARY^DISCHARGE SUMMARY^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
S VAUTVB="VAUTY",DIC="^VAS(393.3,",VAUTSTR="Summary Type",VAUTNI=2 D FIRST^VAUTOMA Q:Y=-1
W !!,*7,"This output requires 132 column output",!
D NOW^%DTC S Y=$E(%,1,12) S VADAT("W")=Y D ^VADATE S DGJTDAT=VADATE("E")
S DGVAR="DGJTDV^DGJTDIR^DGJTDAT^DGJTLPG^DGJTSTAT^DGJTCK^DGJTFL^DGJTMESS^DGJTSR^DGJTSR1^DGJTMUL^DGJTL^DGJTBG^DGJTEND^VAUTD#^VAUTN#^VAUTT#^VAUTY#",DGPGM="START^DGJOTP1" D ZIS^DGJUTQ I 'POP U IO G START^DGJOTP1
G QUIT
START S (DGJTPAG,DGJTDV1,DGJDICTO,DGJTRNTO,DGJCOTO,DGJDYAVG,DGJ30AVG)=0 F IFN=0:0 S IFN=$O(^VAS(393,IFN)) Q:'IFN S DGJTNODE=^VAS(393,IFN,0) D CK
I DGJTLPG=1!(DGJTLPG=3),$D(^UTILITY("VAS",$J)) S (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0,$P(DGJTLN,"=",133)="" G ^DGJOTP2
I DGJTLPG=2,$D(^UTILITY("VAS",$J)) S (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0,$P(DGJTLN,"=",133)="" G ^DGJOTP3
I '$D(^UTILITY("VAS",$J)) W !!,"NO RECORDS"
QUIT G QUIT^DGJOTP
CNT S DGJT5PC=DGJT2PC+DGJT3PC+DGJT4PC
S $P(DGJTOT(DGJTDVN),"^",1)=+DGJTOT(DGJTDVN)+1 I DGJT5PC>30 S $P(DGJTOT(DGJTDVN),"^",2)=$P(DGJTOT(DGJTDVN),"^",2)+1
I DGJTL="PHY" S:'$D(DGJPHTOT(DGJTDVN,DGJTPHY)) DGJPHTOT(DGJTDVN,DGJTPHY)=0 S $P(DGJPHTOT(DGJTDVN,DGJTPHY),"^",1)=$P(DGJPHTOT(DGJTDVN,DGJTPHY),"^",1)+1 S:DGJT5PC>30 $P(DGJPHTOT(DGJTDVN,DGJTPHY),"^",2)=$P(DGJPHTOT(DGJTDVN,DGJTPHY),"^",2)+1
I DGJTL="PHY" D PC Q
I DGJTL="SER" S:'$D(DGJSVTOT(DGJTDVN,DGJTSV)) DGJSVTOT(DGJTDVN,DGJTSV)=0 S $P(DGJSVTOT(DGJTDVN,DGJTSV),"^",1)=$P(DGJSVTOT(DGJTDVN,DGJTSV),"^",1)+1 S:DGJT5PC>30 $P(DGJSVTOT(DGJTDVN,DGJTSV),"^",2)=$P(DGJSVTOT(DGJTDVN,DGJTSV),"^",2)+1 D PC
I DGJTL="SER" S:'$D(DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)) DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=0 S DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)+1
Q
CK I $D(VAUTD),'VAUTD I $P(DGJTNODE,"^",6)]"",'$D(VAUTD($P(DGJTNODE,"^",6))) Q
I $D(DGJTDV),$P(DGJTNODE,"^",6)]"" I $P(DGJTNODE,"^",6)'=DGJTDV Q
I DGJTSR1=1,$P(DGJTNODE,"^",13)'=1 Q
I DGJTSR1=2,$P(DGJTNODE,"^",13)]"" Q
I DGJTSR1'=2 I $P(DGJTNODE,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) S X=$P(DGJTNODE,"^",4) I X]"" I $D(^DGPM(X,0)) S X=$P(^DGPM(X,0),"^",17) Q:X']""
S DGJTPC=$S(DGJTL="SER":8,DGJTL="PHY":14,1:"")
Q:$P(DGJTNODE,"^",2)']"" Q:'$D(^VAS(393.3,$P(DGJTNODE,"^",2),0)) I "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[$P(^VAS(393.3,$P(DGJTNODE,"^",2),0),"^",1) Q
I $D(VAUTN),'VAUTN I '$D(VAUTN(+$P(DGJTNODE,"^",DGJTPC))) Q
I $D(VAUTT),'VAUTT I '$D(VAUTT(+$P(DGJTNODE,"^",7))) Q
I $D(VAUTY),'VAUTY I '$D(VAUTY(+$P(DGJTNODE,"^",2))) Q
I $P(DGJTNODE,"^",3)<DGJTBG!($P(DGJTNODE,"^",3)>DGJTEND) Q
D ^DGJOTPUL I 'DGJTREC Q
S DGJTDIV=$P(DGJTNODE,"^",6),DGJTDVN=$S($P(DGJTNODE,"^",6)]""&($D(^DG(40.8,+$P(DGJTNODE,"^",6),0))):$P(^(0),"^",1),1:"NOT SPECIFIED") I DGJTL'="SER" I '$D(DGJTOT(DGJTDVN)) S DGJTOT(DGJTDVN)=0
I DGJTL="SER" S DGJTDVN=$E(DGJTDVN,1,23) I '$D(DGJTOT(DGJTDVN)) S DGJTOT(DGJTDVN)=0
S DFN=$P(DGJTNODE,"^",1) I $D(^DPT(DFN,0)) S DGJTPT=$P(^(0),"^",1)
I DGJTL="PHY" S DGJTPHY=$S($P(DGJTNODE,"^",DGJTPC)]""&($D(^VA(200,+$P(DGJTNODE,"^",DGJTPC),0))):$P(^(0),"^",1),1:"NOT SPECIFIED") S ^UTILITY("VAS",$J,DGJTDVN,DGJTPHY,DGJTPT,DFN,IFN)=DGJTDL_"^"_DGJT2PC_"^"_DGJT3PC_"^"_DGJT4PC D CNT Q
I DGJTL="SER" S DGJTSV=$S($P(DGJTNODE,"^",DGJTPC)]""&($D(^DG(393.1,+$P(DGJTNODE,"^",DGJTPC),0))):$P(^(0),"^",1),1:"NOT SPECIFIED"),DGJTSP=$S($P(DGJTNODE,"^",7)]""&($D(^DIC(45.7,+$P(DGJTNODE,"^",7),0))):$P(^(0),"^",1),1:"NOT SPECIFIED")
I DGJTL="SER" S DGJTSV=$E(DGJTSV,1,16),DGJTSP=$E(DGJTSP,1,16),DGJTPT=$E(DGJTPT,1,16) S ^UTILITY("VAS",$J,DGJTDVN,DGJTSV,DGJTSP,DGJTPT,DFN,IFN)=DGJTDL_"^"_DGJT2PC_"^"_DGJT3PC_"^"_DGJT4PC D CNT Q
Q
PC S DGJJX=$S(DGJTL="PHY":DGJPHTOT(DGJTDVN,DGJTPHY),1:DGJSVTOT(DGJTDVN,DGJTSV)) S $P(DGJJX,"^",3)=$P(DGJJX,"^",3)+DGJT2PC,$P(DGJJX,"^",4)=$P(DGJJX,"^",4)+DGJT3PC,$P(DGJJX,"^",5)=$P(DGJJX,"^",5)+DGJT4PC D TOT
I DGJTL="PHY" S DGJPHTOT(DGJTDVN,DGJTPHY)=DGJJX
I DGJTL="SER" S DGJSVTOT(DGJTDVN,DGJTSV)=DGJJX
Q
TOT S $P(DGJJX,"^",6)=$P(DGJJX,"^",6)+DGJT2PC+DGJT3PC+DGJT4PC S X=$S((DGJT2PC+DGJT3PC+DGJT4PC)>30:(DGJT2PC+DGJT3PC+DGJT4PC)-30,1:0) S $P(DGJJX,"^",7)=$P(DGJJX,"^",7)+X
Q
PHY S VAUTVB="VAUTN",DIC="^VA(200,",VAUTSTR="Physician",VAUTNI=2 D FIRST^VAUTOMA S:Y=-1 DGJFL=1 Q:DGJFL
Q
SER S VAUTVB="VAUTN",DIC="^DG(393.1,",VAUTSTR="Service",VAUTNI=2 D FIRST^VAUTOMA Q:Y=-1
S VAUTVB="VAUTT",DIC="^DIC(45.7,",VAUTSTR="Specialty",VAUTNI=2 D FIRST^VAUTOMA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJOTP1 4810 printed Nov 22, 2024@17:10:45 Page 2
DGJOTP1 ;MAF/ALB - TRANS PROD REPORT CONT. 1 ; SEP 11 1991@10:00
+1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
+2 ;
+3 IF $DATA(DGJTMUL)
IF DGJTMUL
DO DIVISION^VAUTOMA
if Y=-1
GOTO QUIT
+4 IF 'DGJTMUL
SET DGJTDV=$ORDER(^DG(40.8,0))
+5 DO @(DGJTL)
if Y=-1
GOTO QUIT
+6 DO DAT^DGJOTP
if Y=-1
GOTO QUIT
+7 SET DIC("S")="I $S(""^OP REPORT^INTERIM SUMMARY^DISCHARGE SUMMARY^""[$P(^VAS(393.3,+Y,0),U,1):1,1:0)"
+8 SET VAUTVB="VAUTY"
SET DIC="^VAS(393.3,"
SET VAUTSTR="Summary Type"
SET VAUTNI=2
DO FIRST^VAUTOMA
if Y=-1
QUIT
+9 WRITE !!,*7,"This output requires 132 column output",!
+10 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
SET VADAT("W")=Y
DO ^VADATE
SET DGJTDAT=VADATE("E")
+11 SET DGVAR="DGJTDV^DGJTDIR^DGJTDAT^DGJTLPG^DGJTSTAT^DGJTCK^DGJTFL^DGJTMESS^DGJTSR^DGJTSR1^DGJTMUL^DGJTL^DGJTBG^DGJTEND^VAUTD#^VAUTN#^VAUTT#^VAUTY#"
SET DGPGM="START^DGJOTP1"
DO ZIS^DGJUTQ
IF 'POP
USE IO
GOTO START^DGJOTP1
+12 GOTO QUIT
START SET (DGJTPAG,DGJTDV1,DGJDICTO,DGJTRNTO,DGJCOTO,DGJDYAVG,DGJ30AVG)=0
FOR IFN=0:0
SET IFN=$ORDER(^VAS(393,IFN))
if 'IFN
QUIT
SET DGJTNODE=^VAS(393,IFN,0)
DO CK
+1 IF DGJTLPG=1!(DGJTLPG=3)
IF $DATA(^UTILITY("VAS",$JOB))
SET (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0
SET $PIECE(DGJTLN,"=",133)=""
GOTO ^DGJOTP2
+2 IF DGJTLPG=2
IF $DATA(^UTILITY("VAS",$JOB))
SET (DGJ,DGJTF,DGJTFF,DGJY,DGJTDV,DGJTDT,DGJTSV,DGJTSP,DGJTPHY,DGJTPT,DGU,DFN,IFN)=0
SET $PIECE(DGJTLN,"=",133)=""
GOTO ^DGJOTP3
+3 IF '$DATA(^UTILITY("VAS",$JOB))
WRITE !!,"NO RECORDS"
QUIT GOTO QUIT^DGJOTP
CNT SET DGJT5PC=DGJT2PC+DGJT3PC+DGJT4PC
+1 SET $PIECE(DGJTOT(DGJTDVN),"^",1)=+DGJTOT(DGJTDVN)+1
IF DGJT5PC>30
SET $PIECE(DGJTOT(DGJTDVN),"^",2)=$PIECE(DGJTOT(DGJTDVN),"^",2)+1
+2 IF DGJTL="PHY"
if '$DATA(DGJPHTOT(DGJTDVN,DGJTPHY))
SET DGJPHTOT(DGJTDVN,DGJTPHY)=0
SET $PIECE(DGJPHTOT(DGJTDVN,DGJTPHY),"^",1)=$PIECE(DGJPHTOT(DGJTDVN,DGJTPHY),"^",1)+1
if DGJT5PC>30
SET $PIECE(DGJPHTOT(DGJTDVN,DGJTPHY),"^",2)=$PIECE(DGJPHTOT(DGJTDVN,DGJTPHY),"^",2)+1
+3 IF DGJTL="PHY"
DO PC
QUIT
+4 IF DGJTL="SER"
if '$DATA(DGJSVTOT(DGJTDVN,DGJTSV))
SET DGJSVTOT(DGJTDVN,DGJTSV)=0
SET $PIECE(DGJSVTOT(DGJTDVN,DGJTSV),"^",1)=$PIECE(DGJSVTOT(DGJTDVN,DGJTSV),"^",1)+1
if DGJT5PC>30
SET $PIECE(DGJSVTOT(DGJTDVN,DGJTSV),"^",2)=$PIECE(DGJSVTOT(DGJTDVN,DGJTSV),"^",2)+1
DO PC
+5 IF DGJTL="SER"
if '$DATA(DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP))
SET DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=0
SET DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)=DGJSPTOT(DGJTDVN,DGJTSV,DGJTSP)+1
+6 QUIT
CK IF $DATA(VAUTD)
IF 'VAUTD
IF $PIECE(DGJTNODE,"^",6)]""
IF '$DATA(VAUTD($PIECE(DGJTNODE,"^",6)))
QUIT
+1 IF $DATA(DGJTDV)
IF $PIECE(DGJTNODE,"^",6)]""
IF $PIECE(DGJTNODE,"^",6)'=DGJTDV
QUIT
+2 IF DGJTSR1=1
IF $PIECE(DGJTNODE,"^",13)'=1
QUIT
+3 IF DGJTSR1=2
IF $PIECE(DGJTNODE,"^",13)]""
QUIT
+4 IF DGJTSR1'=2
IF $PIECE(DGJTNODE,"^",2)=$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0))
SET X=$PIECE(DGJTNODE,"^",4)
IF X]""
IF $DATA(^DGPM(X,0))
SET X=$PIECE(^DGPM(X,0),"^",17)
if X']""
QUIT
+5 SET DGJTPC=$SELECT(DGJTL="SER":8,DGJTL="PHY":14,1:"")
+6 if $PIECE(DGJTNODE,"^",2)']""
QUIT
if '$DATA(^VAS(393.3,$PIECE(DGJTNODE,"^",2),0))
QUIT
IF "^OP REPORT^DISCHARGE SUMMARY^INTERIM SUMMARY^"'[$PIECE(^VAS(393.3,$PIECE(DGJTNODE,"^",2),0),"^",1)
QUIT
+7 IF $DATA(VAUTN)
IF 'VAUTN
IF '$DATA(VAUTN(+$PIECE(DGJTNODE,"^",DGJTPC)))
QUIT
+8 IF $DATA(VAUTT)
IF 'VAUTT
IF '$DATA(VAUTT(+$PIECE(DGJTNODE,"^",7)))
QUIT
+9 IF $DATA(VAUTY)
IF 'VAUTY
IF '$DATA(VAUTY(+$PIECE(DGJTNODE,"^",2)))
QUIT
+10 IF $PIECE(DGJTNODE,"^",3)<DGJTBG!($PIECE(DGJTNODE,"^",3)>DGJTEND)
QUIT
+11 DO ^DGJOTPUL
IF 'DGJTREC
QUIT
+12 SET DGJTDIV=$PIECE(DGJTNODE,"^",6)
SET DGJTDVN=$SELECT($PIECE(DGJTNODE,"^",6)]""&($DATA(^DG(40.8,+$PIECE(DGJTNODE,"^",6),0))):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
IF DGJTL'="SER"
IF '$DATA(DGJTOT(DGJTDVN))
SET DGJTOT(DGJTDVN)=0
+13 IF DGJTL="SER"
SET DGJTDVN=$EXTRACT(DGJTDVN,1,23)
IF '$DATA(DGJTOT(DGJTDVN))
SET DGJTOT(DGJTDVN)=0
+14 SET DFN=$PIECE(DGJTNODE,"^",1)
IF $DATA(^DPT(DFN,0))
SET DGJTPT=$PIECE(^(0),"^",1)
+15 IF DGJTL="PHY"
SET DGJTPHY=$SELECT($PIECE(DGJTNODE,"^",DGJTPC)]""&($DATA(^VA(200,+$PIECE(DGJTNODE,"^",DGJTPC),0))):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
SET ^UTILITY("VAS",$JOB,DGJTDVN,DGJTPHY,DGJTPT,DFN,IFN)=DGJTDL_"^"_DGJT2PC_"^"_DGJT3PC_"^"_DGJT4PC
DO CNT
QUIT
+16 IF DGJTL="SER"
SET DGJTSV=$SELECT($PIECE(DGJTNODE,"^",DGJTPC)]""&($DATA(^DG(393.1,+$PIECE(DGJTNODE,"^",DGJTPC),0))):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
SET DGJTSP=$SELECT($PIECE(DGJTNODE,"^",7)]""&($DATA(^DIC(45.7,+$PIECE(DGJTNODE,"^",7),0))):$PIECE(^(0),"^",1),1:"NOT SPECIFIED")
+17 IF DGJTL="SER"
SET DGJTSV=$EXTRACT(DGJTSV,1,16)
SET DGJTSP=$EXTRACT(DGJTSP,1,16)
SET DGJTPT=$EXTRACT(DGJTPT,1,16)
SET ^UTILITY("VAS",$JOB,DGJTDVN,DGJTSV,DGJTSP,DGJTPT,DFN,IFN)=DGJTDL_"^"_DGJT2PC_"^"_DGJT3PC_"^"_DGJT4PC
DO CNT
QUIT
+18 QUIT
PC SET DGJJX=$SELECT(DGJTL="PHY":DGJPHTOT(DGJTDVN,DGJTPHY),1:DGJSVTOT(DGJTDVN,DGJTSV))
SET $PIECE(DGJJX,"^",3)=$PIECE(DGJJX,"^",3)+DGJT2PC
SET $PIECE(DGJJX,"^",4)=$PIECE(DGJJX,"^",4)+DGJT3PC
SET $PIECE(DGJJX,"^",5)=$PIECE(DGJJX,"^",5)+DGJT4PC
DO TOT
+1 IF DGJTL="PHY"
SET DGJPHTOT(DGJTDVN,DGJTPHY)=DGJJX
+2 IF DGJTL="SER"
SET DGJSVTOT(DGJTDVN,DGJTSV)=DGJJX
+3 QUIT
TOT SET $PIECE(DGJJX,"^",6)=$PIECE(DGJJX,"^",6)+DGJT2PC+DGJT3PC+DGJT4PC
SET X=$SELECT((DGJT2PC+DGJT3PC+DGJT4PC)>30:(DGJT2PC+DGJT3PC+DGJT4PC)-30,1:0)
SET $PIECE(DGJJX,"^",7)=$PIECE(DGJJX,"^",7)+X
+1 QUIT
PHY SET VAUTVB="VAUTN"
SET DIC="^VA(200,"
SET VAUTSTR="Physician"
SET VAUTNI=2
DO FIRST^VAUTOMA
if Y=-1
SET DGJFL=1
if DGJFL
QUIT
+1 QUIT
SER SET VAUTVB="VAUTN"
SET DIC="^DG(393.1,"
SET VAUTSTR="Service"
SET VAUTNI=2
DO FIRST^VAUTOMA
if Y=-1
QUIT
+1 SET VAUTVB="VAUTT"
SET DIC="^DIC(45.7,"
SET VAUTSTR="Specialty"
SET VAUTNI=2
DO FIRST^VAUTOMA
+2 QUIT
