- DGPMGL2 ;ALB/LM - ADC INFO; 5 NOV 90
- ;;5.3;Registration;**59,1015**;Aug 13, 1993;Build 21
- ;
- 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
- DGPMGL2 ;ALB/LM - ADC INFO; 5 NOV 90
- +1 ;;5.3;Registration;**59,1015**;Aug 13, 1993;Build 21
- +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
