DGPMGL2 ;ALB/LM - ADC INFO; 5 NOV 90
;;5.3;Registration;**59**;Aug 13, 1993
;
A S DGHX=""
F DGN=0:0 S DGN=$O(^DG(40.8,DGN)) Q:'DGN K DR I $D(^(DGN,0)) I '$P(^(0),"^",3) W !!,"SITE: ",$P(^(0),"^") D DGN G Q:'$D(^DG(40.8,DGN,"CEN",RD,0)) F I=2:1:12 S $P(DGHX,"^",I)=$P(DGHX,"^",I)+$P(^DG(40.8,DGN,"CEN",RD,0),"^",I)
;
Q K DGN,I,DGHX
Q1 K DA,DIE,DP,DR,X,Y Q
;
DGN I '$D(^DG(40.8,DGN,"CEN",0)) S Y=RD W " WHAT WAS THE CENSUS ON " D DT^DIQ R "? ",X:DTIME Q:X["^" I $S((X\1'=X):1,X'=0:1,1:0) W !?4,"Enter a WHOLE NUMBER without fractions or '0' or up-arrow [""^""] to QUIT!!",*7,! G DGN
S:'$D(^DG(40.8,DGN,"CEN",0)) ^(0)="^40.802^^"
; S DR="5///"_X ; this was in original code but ? was it used
K Y
DGN1 I $P($G(^DG(40.8,DGN,"CEN",RD,0)),U,4)="" D
. ; brings in default values from previous date
.N X,Y
.I $D(^DG(40.8,DGN,"CEN",PD,0)) S X=^(0)
.I '$G(X) S Y=+$O(^DG(40.8,DGN,"CEN",RD),-1),X=$S('Y:"",1:^(Y,0))
.S ^DG(40.8,DGN,"CEN",RD,0)=RD_"^"_$P(X,U,2,99)
.K X,Y
S DR="3;" ; Cum Planned ADC
S DR=DR_"S:'+$P(^DG(43,1,0),U,20) Y=""@1"";1;@1;" ; Cum Planned NH ADC
S DR=DR_"S:'+$P(^DG(43,1,0),U,21) Y=""@2"";1.25;@2;" ; Cum Planned Dom ADC
S DR=DR_"2;" ; Monthly Planned ADC
S DR=DR_"S:'+$P(^DG(43,1,0),U,20) Y=""@3"";2.25;@3;" ; Monthly Planned NH ADC
S DR=DR_"S:'+$P(^DG(43,1,0),U,21) Y=""@4"";2.5;@4;" ; Monthy Planned Dom ADC
S DR=DR_"4///0;20" ; 4=Dialysis patients 20=Corrections to Previous G&L's
S DIE="^DG(40.8,"_DGN_",""CEN"","
S DA=RD,DA(1)=DGN,DP=40.802 K Y
D ^DIE
D Q1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMGL2 1539 printed Oct 16, 2024@18:50:11 Page 2
DGPMGL2 ;ALB/LM - ADC INFO; 5 NOV 90
+1 ;;5.3;Registration;**59**;Aug 13, 1993
+2 ;
A SET DGHX=""
+1 FOR DGN=0:0
SET DGN=$ORDER(^DG(40.8,DGN))
if 'DGN
QUIT
KILL DR
IF $DATA(^(DGN,0))
IF '$PIECE(^(0),"^",3)
WRITE !!,"SITE: ",$PIECE(^(0),"^")
DO DGN
if '$DATA(^DG(40.8,DGN,"CEN",RD,0))
GOTO Q
FOR I=2:1:12
SET $PIECE(DGHX,"^",I)=$PIECE(DGHX,"^",I)+$PIECE(^DG(40.8,DGN,"CEN",RD,0),"^",I)
+2 ;
Q KILL DGN,I,DGHX
Q1 KILL DA,DIE,DP,DR,X,Y
QUIT
+1 ;
DGN IF '$DATA(^DG(40.8,DGN,"CEN",0))
SET Y=RD
WRITE " WHAT WAS THE CENSUS ON "
DO DT^DIQ
READ "? ",X:DTIME
if X["^"
QUIT
IF $SELECT((X\1'=X):1,X'=0:1,1:0)
WRITE !?4,"Enter a WHOLE NUMBER without fractions or '0' or up-arrow [""^""] to QUIT!!",*7,!
GOTO DGN
+1 if '$DATA(^DG(40.8,DGN,"CEN",0))
SET ^(0)="^40.802^^"
+2 ; S DR="5///"_X ; this was in original code but ? was it used
+3 KILL Y
DGN1 IF $PIECE($GET(^DG(40.8,DGN,"CEN",RD,0)),U,4)=""
Begin DoDot:1
+1 ; brings in default values from previous date
+2 NEW X,Y
+3 IF $DATA(^DG(40.8,DGN,"CEN",PD,0))
SET X=^(0)
+4 IF '$GET(X)
SET Y=+$ORDER(^DG(40.8,DGN,"CEN",RD),-1)
SET X=$SELECT('Y:"",1:^(Y,0))
+5 SET ^DG(40.8,DGN,"CEN",RD,0)=RD_"^"_$PIECE(X,U,2,99)
+6 KILL X,Y
End DoDot:1
+7 ; Cum Planned ADC
SET DR="3;"
+8 ; Cum Planned NH ADC
SET DR=DR_"S:'+$P(^DG(43,1,0),U,20) Y=""@1"";1;@1;"
+9 ; Cum Planned Dom ADC
SET DR=DR_"S:'+$P(^DG(43,1,0),U,21) Y=""@2"";1.25;@2;"
+10 ; Monthly Planned ADC
SET DR=DR_"2;"
+11 ; Monthly Planned NH ADC
SET DR=DR_"S:'+$P(^DG(43,1,0),U,20) Y=""@3"";2.25;@3;"
+12 ; Monthy Planned Dom ADC
SET DR=DR_"S:'+$P(^DG(43,1,0),U,21) Y=""@4"";2.5;@4;"
+13 ; 4=Dialysis patients 20=Corrections to Previous G&L's
SET DR=DR_"4///0;20"
+14 SET DIE="^DG(40.8,"_DGN_",""CEN"","
+15 SET DA=RD
SET DA(1)=DGN
SET DP=40.802
KILL Y
+16 DO ^DIE
+17 DO Q1
+18 QUIT
