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 Oct 16, 2024@18:47:01 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
