- DGODMT ;ALB/MRL - DETERMINE & STORE PTF MEANS TEST INDICATOR ; 10 FEB 87
- ;;5.3;Registration;;Aug 13, 1993
- ;;V 4.5 ;; ALB/EG - MODIFIED TO DETERMINE MT, NO UPDATE ; 11 APR 89
- EN ;
- S DGZEC=$S($D(^DPT(DFN,.36)):$P(^(.36),U,1),1:""),DGZEC=$S($D(^DIC(8,+DGZEC,0)):^(0),1:"") I $P(DGZEC,U,5)="N" S DGX="N" Q
- I $D(AD),AD<2860701 S DGX="X" Q
- I $D(^DGPT(PTF,101)) S DGT=+^(101) I DGT=48!(DGT=49)!(DGT=50) S DGX="X" Q
- I $P(^DG(43,1,0),U,21),AD]"" S DGT=AD D ^DGINPW I DG1,$S('$D(^DIC(42,+DG1,0)):0,$P(^(0),U,3)="D":1,1:0) S DGX="X" Q
- S DGT=$S($D(^DGPT(PTF,70)):$P(^(70),U,1),1:""),DGT=9999999-$S(DGT]"":DGT,1:DT_.9) G AS:'$D(^DG(41.3,DFN,0)) F DGZ=0:0 S DGZ=$O(^DG(41.3,DFN,2,DGZ)) Q:'DGZ!($D(DGZ1)) I DGZ>DGT S DGZ1=^(DGZ,0)
- S DGX=$S('$D(DGZ1):"U",1:$P(DGZ1,U,2)),DGX=$S(DGX="A":"AN","BN"[DGX:DGX,"CP"[DGX:"C",1:"U") I DGX'="N" Q
- AS S DGZ=$S($D(^DPT(DFN,.321)):^(.321),1:0) I $P(DGZ,U,2)="Y"!($P(DGZ,U,3)="Y") S DGX="AS" Q
- I $P(DGZEC,U,5)="Y",$P(DGZEC,U,4)<4,"^2^15^"'[("^"_$P(DGZEC,U,9)_"^") S DGX="AS" Q
- I DGZEC]"" S DGX="AN" Q
- S DGX="U" K DGZEC,DGZ,DGZ1,DG1,DR,DGT
- Q
- TOTW ;get inpatients remaining in hospital
- S (DG0X,X)=0 F I=0:0 S X=$O(^DPT("CN",X)) Q:X="" I $O(^DIC(42,"B",X,0))'="",$P(^DIC(42,$O(^DIC(42,"B",X,0)),0),U,11)'="" D TOTW0
- S X="" F I=A2:1 S X=$O(Z(X)) Q:X="" S DGDVN=$S($D(^DG(40.8,"C",X))>0:^DG(40.8,$O(^DG(40.8,"C",X,0)),0),1:"^"),DGDV=$P(DGDVN,U,1),DGDVN=$P(DGDVN,U,2),^UTILITY("DGOD",$J,"AI",I+1)=DGDV_U_DGDVN_U_Z(X),^(0)=A2
- Q
- TOTW0 I $D(Z($P(^DG(40.8,$P(^DIC(42,$O(^DIC(42,"B",X,0)),0),U,11),0),U,2)))=0 S Z($P(^DG(40.8,$P(^DIC(42,$O(^DIC(42,"B",X,0)),0),U,11),0),U,2))=0,DG0X=DG0X+1
- S:$D(A(DG0X+A2))=0 A(DG0X+A2)=^DG(40.8,$P(^DIC(42,$O(^DIC(42,"B",X,0)),0),U,11),0) D TOTW1
- Q
- TOTW1 S Y=0,DGDV=$P(^DG(40.8,$P(^DIC(42,$O(^DIC(42,"B",X,0)),0),U,11),0),U,2)
- F I=0:0 S Y=$O(^DPT("CN",X,Y)) Q:Y="" S Z($P(^DG(40.8,$P(^DIC(42,$O(^DIC(42,"B",X,0)),0),U,11),0),U,2))=Z($P(^DG(40.8,$P(^DIC(42,$O(^DIC(42,"B",X,0)),0),U,11),0),U,2))+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGODMT 1990 printed Feb 19, 2025@00:12:25 Page 2
- DGODMT ;ALB/MRL - DETERMINE & STORE PTF MEANS TEST INDICATOR ; 10 FEB 87
- +1 ;;5.3;Registration;;Aug 13, 1993
- +2 ;;V 4.5 ;; ALB/EG - MODIFIED TO DETERMINE MT, NO UPDATE ; 11 APR 89
- EN ;
- +1 SET DGZEC=$SELECT($DATA(^DPT(DFN,.36)):$PIECE(^(.36),U,1),1:"")
- SET DGZEC=$SELECT($DATA(^DIC(8,+DGZEC,0)):^(0),1:"")
- IF $PIECE(DGZEC,U,5)="N"
- SET DGX="N"
- QUIT
- +2 IF $DATA(AD)
- IF AD<2860701
- SET DGX="X"
- QUIT
- +3 IF $DATA(^DGPT(PTF,101))
- SET DGT=+^(101)
- IF DGT=48!(DGT=49)!(DGT=50)
- SET DGX="X"
- QUIT
- +4 IF $PIECE(^DG(43,1,0),U,21)
- IF AD]""
- SET DGT=AD
- DO ^DGINPW
- IF DG1
- IF $SELECT('$DATA(^DIC(42,+DG1,0)):0,$PIECE(^(0),U,3)="D":1,1:0)
- SET DGX="X"
- QUIT
- +5 SET DGT=$SELECT($DATA(^DGPT(PTF,70)):$PIECE(^(70),U,1),1:"")
- SET DGT=9999999-$SELECT(DGT]"":DGT,1:DT_.9)
- if '$DATA(^DG(41.3,DFN,0))
- GOTO AS
- FOR DGZ=0:0
- SET DGZ=$ORDER(^DG(41.3,DFN,2,DGZ))
- if 'DGZ!($DATA(DGZ1))
- QUIT
- IF DGZ>DGT
- SET DGZ1=^(DGZ,0)
- +6 SET DGX=$SELECT('$DATA(DGZ1):"U",1:$PIECE(DGZ1,U,2))
- SET DGX=$SELECT(DGX="A":"AN","BN"[DGX:DGX,"CP"[DGX:"C",1:"U")
- IF DGX'="N"
- QUIT
- AS SET DGZ=$SELECT($DATA(^DPT(DFN,.321)):^(.321),1:0)
- IF $PIECE(DGZ,U,2)="Y"!($PIECE(DGZ,U,3)="Y")
- SET DGX="AS"
- QUIT
- +1 IF $PIECE(DGZEC,U,5)="Y"
- IF $PIECE(DGZEC,U,4)<4
- IF "^2^15^"'[("^"_$PIECE(DGZEC,U,9)_"^")
- SET DGX="AS"
- QUIT
- +2 IF DGZEC]""
- SET DGX="AN"
- QUIT
- +3 SET DGX="U"
- KILL DGZEC,DGZ,DGZ1,DG1,DR,DGT
- +4 QUIT
- TOTW ;get inpatients remaining in hospital
- +1 SET (DG0X,X)=0
- FOR I=0:0
- SET X=$ORDER(^DPT("CN",X))
- if X=""
- QUIT
- IF $ORDER(^DIC(42,"B",X,0))'=""
- IF $PIECE(^DIC(42,$ORDER(^DIC(42,"B",X,0)),0),U,11)'=""
- DO TOTW0
- +2 SET X=""
- FOR I=A2:1
- SET X=$ORDER(Z(X))
- if X=""
- QUIT
- SET DGDVN=$SELECT($DATA(^DG(40.8,"C",X))>0:^DG(40.8,$ORDER(^DG(40.8,"C",X,0)),0),1:"^")
- SET DGDV=$PIECE(DGDVN,U,1)
- SET DGDVN=$PIECE(DGDVN,U,2)
- SET ^UTILITY("DGOD",$JOB,"AI",I+1)=DGDV_U_DGDVN_U_Z(X)
- SET ^(0)=A2
- +3 QUIT
- TOTW0 IF $DATA(Z($PIECE(^DG(40.8,$PIECE(^DIC(42,$ORDER(^DIC(42,"B",X,0)),0),U,11),0),U,2)))=0
- SET Z($PIECE(^DG(40.8,$PIECE(^DIC(42,$ORDER(^DIC(42,"B",X,0)),0),U,11),0),U,2))=0
- SET DG0X=DG0X+1
- +1 if $DATA(A(DG0X+A2))=0
- SET A(DG0X+A2)=^DG(40.8,$PIECE(^DIC(42,$ORDER(^DIC(42,"B",X,0)),0),U,11),0)
- DO TOTW1
- +2 QUIT
- TOTW1 SET Y=0
- SET DGDV=$PIECE(^DG(40.8,$PIECE(^DIC(42,$ORDER(^DIC(42,"B",X,0)),0),U,11),0),U,2)
- +1 FOR I=0:0
- SET Y=$ORDER(^DPT("CN",X,Y))
- if Y=""
- QUIT
- SET Z($PIECE(^DG(40.8,$PIECE(^DIC(42,$ORDER(^DIC(42,"B",X,0)),0),U,11),0),U,2))=Z($PIECE(^DG(40.8,$PIECE(^DIC(42,$ORDER(^DIC(42,"B",X,0)),0),U,11),0),U,2))+1
- +2 QUIT