source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMGL2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1DGPMGL2 ;ALB/LM - ADC INFO; 5 NOV 90
2 ;;5.3;Registration;**59**;Aug 13, 1993
3 ;
4A S DGHX=""
5 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)
6 ;
7Q K DGN,I,DGHX
8Q1 K DA,DIE,DP,DR,X,Y Q
9 ;
10DGN 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
11 S:'$D(^DG(40.8,DGN,"CEN",0)) ^(0)="^40.802^^"
12 ; S DR="5///"_X ; this was in original code but ? was it used
13 K Y
14DGN1 I $P($G(^DG(40.8,DGN,"CEN",RD,0)),U,4)="" D
15 . ; brings in default values from previous date
16 .N X,Y
17 .I $D(^DG(40.8,DGN,"CEN",PD,0)) S X=^(0)
18 .I '$G(X) S Y=+$O(^DG(40.8,DGN,"CEN",RD),-1),X=$S('Y:"",1:^(Y,0))
19 .S ^DG(40.8,DGN,"CEN",RD,0)=RD_"^"_$P(X,U,2,99)
20 .K X,Y
21 S DR="3;" ; Cum Planned ADC
22 S DR=DR_"S:'+$P(^DG(43,1,0),U,20) Y=""@1"";1;@1;" ; Cum Planned NH ADC
23 S DR=DR_"S:'+$P(^DG(43,1,0),U,21) Y=""@2"";1.25;@2;" ; Cum Planned Dom ADC
24 S DR=DR_"2;" ; Monthly Planned ADC
25 S DR=DR_"S:'+$P(^DG(43,1,0),U,20) Y=""@3"";2.25;@3;" ; Monthly Planned NH ADC
26 S DR=DR_"S:'+$P(^DG(43,1,0),U,21) Y=""@4"";2.5;@4;" ; Monthy Planned Dom ADC
27 S DR=DR_"4///0;20" ; 4=Dialysis patients 20=Corrections to Previous G&L's
28 S DIE="^DG(40.8,"_DGN_",""CEN"","
29 S DA=RD,DA(1)=DGN,DP=40.802 K Y
30 D ^DIE
31 D Q1
32 Q
Note: See TracBrowser for help on using the repository browser.