DGPMGL2.m

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 ---DGPMGL2   1539     printed  Apr 09, 2024@21:57:40                                                                                                                                                                                                     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