- DGJOTPUL ;ALB/MAF - CHECK PARAMETERS FOR TRANS PROD REPORT ; FEB 12 1991
- ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- S DGJT1X="",(DGJTFLAG,DGJTREC,DGJT2PC,DGJT3PC,DGJT4PC,DGJT5PC)=0,DGJTNODE=^VAS(393,IFN,0),DGJTDEL=$S($D(^DG(40.8,+$P(DGJTNODE,"^",6),"DT")):^("DT"),1:"") S DGJTPAR=$P(DGJTDEL,"^",6)_"^"_$P(DGJTDEL,"^",7)_"^"_$P(DGJTDEL,"^",8)
- K DGJTNODT I $D(^VAS(393,IFN,"DT")) S DGJTNODT=^VAS(393,IFN,"DT")
- D NOW^%DTC S X=%,DGJTNOW=X\1 S DGJTDL=0
- I DGJTSTAT[("^"_$P(DGJTNODE,"^",11)_"^") S DGJTREC=1 D PROC
- Q Q
- PROC I $P(DGJTNODE,"^",11)=$O(^DG(393.2,"B","INCOMPLETE",0)) S X1=$P(DGJTNODE,"^",3),X2=+DGJTPAR D C^%DTC S DGJTFLAG=$S(DGJTNOW=$E(X,1,7):1,DGJTNOW>(X\1):1,1:0) S:DGJTFLAG DGJTDL=DGJTNOW-$E(X,1,7) D:DGJTFLAG DAYS D TOT1 Q
- I $P(DGJTNODE,"^",11)=$O(^DG(393.2,"B","DICTATED",0)) S DGJTFLAG=1,X=$P(DGJTNODE,"^",3) D DAYS,TOT1 Q
- I $P(DGJTNODE,"^",11)=$O(^DG(393.2,"B","TRANSCRIBED",0)) S X1=$P(DGJTNODT,"^",3),X2=$P(DGJTPAR,"^",2) D C^%DTC S:DGJTNOW'<(X\1) DGJTFLAG=1 D:DGJTFLAG DAYS D TOT1 Q
- Q:$P(DGJTDEL,"^",3)=0 I $P(DGJTNODE,"^",11)=$O(^DG(393.2,"B","SIGNED",0)) S X1=$P(DGJTNODT,"^",5),X2=$P(DGJTPAR,"^",3) D C^%DTC S:DGJTNOW'<(X\1) DGJTFLAG=1 D:DGJTFLAG DAYS D TOT1 Q
- Q
- DAYS S X1=DGJTNOW,X2=X\1 D ^%DTC S DGJTDL=X Q
- TOT1 S DGJTFLLG=0 S X1=$S('$D(DGJTNODT):DGJTNOW,$D(DGJTNODT)&($P(DGJTNODT,"^",1)]""):$P(DGJTNODT,"^",1),1:DGJTNOW),X2=$P(DGJTNODE,"^",3) S:X2>X1 X1=X2 D ^%DTC
- I $D(DGJTNODT),$P(DGJTNODT,"^",1)']"",$P(DGJTNODT,"^",5)]"" S DGJT2PC="-" D COD S X1=$S(X]"":X,1:DGJTNOW),X2=$P(DGJTNODE,"^",3) D ^%DTC D SET S DGJT3PC="-" Q
- S DGJDICTO=DGJDICTO+X S DGJT2PC=X_"*"
- I $D(DGJTNODT),$P(DGJTNODT,"^",1)]"" S X1=$S($P(DGJTNODT,"^",3)]"":$P(DGJTNODT,"^",3),1:DGJTNOW),X2=$P(DGJTNODT,"^",1) D ^%DTC S DGJTRNTO=DGJTRNTO+X S DGJT3PC=X_"*" S DGJT2PC=+DGJT2PC
- I $D(DGJTNODT),$P(DGJTNODT,"^",3)]"" D COD
- I $D(DGJTNODT),$P(DGJTNODT,"^",3)]"" S X1=$S(X]"":X,1:DGJTNOW),X2=$P(DGJTNODT,"^",3) D ^%DTC D SET
- Q
- COD S X=$P(DGJTNODE,"^",4) S X=$S($D(^DGPM(+X,0)):$P(^(0),"^",16),1:"") I X]"" S X=$S($D(^DGPT(X,0)):$P(^DGPT(X,0),"^",9),1:"") I X]"" S X=$S($D(^DGP(45.84,+X,0)):$P(^(0),"^",2),1:"")
- I X']"" S DGJTFLLG=1
- Q
- SET S DGJCOTO=DGJCOTO+X S:DGJTFLLG DGJT4PC=X_"*" S:'DGJTFLLG DGJT4PC=X S DGJT3PC=+DGJT3PC Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJOTPUL 2265 printed Feb 18, 2025@23:27:02 Page 2
- DGJOTPUL ;ALB/MAF - CHECK PARAMETERS FOR TRANS PROD REPORT ; FEB 12 1991
- +1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- +2 SET DGJT1X=""
- SET (DGJTFLAG,DGJTREC,DGJT2PC,DGJT3PC,DGJT4PC,DGJT5PC)=0
- SET DGJTNODE=^VAS(393,IFN,0)
- SET DGJTDEL=$SELECT($DATA(^DG(40.8,+$PIECE(DGJTNODE,"^",6),"DT")):^("DT"),1:"")
- SET DGJTPAR=$PIECE(DGJTDEL,"^",6)_"^"_$PIECE(DGJTDEL,"^",7)_"^"_$PIECE(DGJTDEL,"^",8)
- +3 KILL DGJTNODT
- IF $DATA(^VAS(393,IFN,"DT"))
- SET DGJTNODT=^VAS(393,IFN,"DT")
- +4 DO NOW^%DTC
- SET X=%
- SET DGJTNOW=X\1
- SET DGJTDL=0
- +5 IF DGJTSTAT[("^"_$PIECE(DGJTNODE,"^",11)_"^")
- SET DGJTREC=1
- DO PROC
- Q QUIT
- PROC IF $PIECE(DGJTNODE,"^",11)=$ORDER(^DG(393.2,"B","INCOMPLETE",0))
- SET X1=$PIECE(DGJTNODE,"^",3)
- SET X2=+DGJTPAR
- DO C^%DTC
- SET DGJTFLAG=$SELECT(DGJTNOW=$EXTRACT(X,1,7):1,DGJTNOW>(X\1):1,1:0)
- if DGJTFLAG
- SET DGJTDL=DGJTNOW-$EXTRACT(X,1,7)
- if DGJTFLAG
- DO DAYS
- DO TOT1
- QUIT
- +1 IF $PIECE(DGJTNODE,"^",11)=$ORDER(^DG(393.2,"B","DICTATED",0))
- SET DGJTFLAG=1
- SET X=$PIECE(DGJTNODE,"^",3)
- DO DAYS
- DO TOT1
- QUIT
- +2 IF $PIECE(DGJTNODE,"^",11)=$ORDER(^DG(393.2,"B","TRANSCRIBED",0))
- SET X1=$PIECE(DGJTNODT,"^",3)
- SET X2=$PIECE(DGJTPAR,"^",2)
- DO C^%DTC
- if DGJTNOW'<(X\1)
- SET DGJTFLAG=1
- if DGJTFLAG
- DO DAYS
- DO TOT1
- QUIT
- +3 if $PIECE(DGJTDEL,"^",3)=0
- QUIT
- IF $PIECE(DGJTNODE,"^",11)=$ORDER(^DG(393.2,"B","SIGNED",0))
- SET X1=$PIECE(DGJTNODT,"^",5)
- SET X2=$PIECE(DGJTPAR,"^",3)
- DO C^%DTC
- if DGJTNOW'<(X\1)
- SET DGJTFLAG=1
- if DGJTFLAG
- DO DAYS
- DO TOT1
- QUIT
- +4 QUIT
- DAYS SET X1=DGJTNOW
- SET X2=X\1
- DO ^%DTC
- SET DGJTDL=X
- QUIT
- TOT1 SET DGJTFLLG=0
- SET X1=$SELECT('$DATA(DGJTNODT):DGJTNOW,$DATA(DGJTNODT)&($PIECE(DGJTNODT,"^",1)]""):$PIECE(DGJTNODT,"^",1),1:DGJTNOW)
- SET X2=$PIECE(DGJTNODE,"^",3)
- if X2>X1
- SET X1=X2
- DO ^%DTC
- +1 IF $DATA(DGJTNODT)
- IF $PIECE(DGJTNODT,"^",1)']""
- IF $PIECE(DGJTNODT,"^",5)]""
- SET DGJT2PC="-"
- DO COD
- SET X1=$SELECT(X]"":X,1:DGJTNOW)
- SET X2=$PIECE(DGJTNODE,"^",3)
- DO ^%DTC
- DO SET
- SET DGJT3PC="-"
- QUIT
- +2 SET DGJDICTO=DGJDICTO+X
- SET DGJT2PC=X_"*"
- +3 IF $DATA(DGJTNODT)
- IF $PIECE(DGJTNODT,"^",1)]""
- SET X1=$SELECT($PIECE(DGJTNODT,"^",3)]"":$PIECE(DGJTNODT,"^",3),1:DGJTNOW)
- SET X2=$PIECE(DGJTNODT,"^",1)
- DO ^%DTC
- SET DGJTRNTO=DGJTRNTO+X
- SET DGJT3PC=X_"*"
- SET DGJT2PC=+DGJT2PC
- +4 IF $DATA(DGJTNODT)
- IF $PIECE(DGJTNODT,"^",3)]""
- DO COD
- +5 IF $DATA(DGJTNODT)
- IF $PIECE(DGJTNODT,"^",3)]""
- SET X1=$SELECT(X]"":X,1:DGJTNOW)
- SET X2=$PIECE(DGJTNODT,"^",3)
- DO ^%DTC
- DO SET
- +6 QUIT
- COD SET X=$PIECE(DGJTNODE,"^",4)
- SET X=$SELECT($DATA(^DGPM(+X,0)):$PIECE(^(0),"^",16),1:"")
- IF X]""
- SET X=$SELECT($DATA(^DGPT(X,0)):$PIECE(^DGPT(X,0),"^",9),1:"")
- IF X]""
- SET X=$SELECT($DATA(^DGP(45.84,+X,0)):$PIECE(^(0),"^",2),1:"")
- +1 IF X']""
- SET DGJTFLLG=1
- +2 QUIT
- SET SET DGJCOTO=DGJCOTO+X
- if DGJTFLLG
- SET DGJT4PC=X_"*"
- if 'DGJTFLLG
- SET DGJT4PC=X
- SET DGJT3PC=+DGJT3PC
- QUIT
