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

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

initial load of WorldVistAEHR
File size: 1.5 KB
RevLine 
[613]1DGYRCOV ;ALB/CAW - Convert MT pointer from 408.21 to 408.22;10/27/94
2 ;;5.3;Registration;**45**;Aug 13, 1993
3 ;
4GETREL ; Get all active relations for that year
5 N CNT,DEP,DGDATE,DGERR,DGMT,DGINC,DGINI,DGIRI,DGMTI,DGREL,DFN,DATE,INC,INR,FLAG,FLAG1
6 S (DGMT,CNT)=0
7 F S DGMT=$O(^DGMT(408.31,DGMT)) Q:'DGMT S DGMTI=^(DGMT,0) D
8 .S CNT=CNT+1
9 .K FLAG
10 .I '$P(DGMTI,U)!'$P(DGMTI,U,2) S ^TMP("DGMTERR",$J,DGMT)="" Q
11 .S DFN=$P(DGMTI,U,2)
12 .S DATE=$P(DGMTI,U)
13 .D GETREL^DGMTU11(DFN,"VSC",DATE) Q:'$G(DGREL("V"))
14 .D GETIENS^DGMTU2(DFN,+DGREL("V"),DATE) I $G(DGINI),$G(DGIRI) D DIE
15 .I $G(DGREL("S")) D GETIENS^DGMTU2(DFN,+DGREL("S"),DATE) I $G(DGINI),$G(DGIRI) D DIE
16 .S DEP=0 F S DEP=$O(DGREL("C",DEP)) Q:'DEP D
17 ..D GETIENS^DGMTU2(DFN,+DGREL("C",DEP),DATE) I $G(DGINI),$G(DGIRI) D DIE
18 .I '(CNT#100) W "."
19 ;
20 ; Fix any remaining pointers
21 N DGMT,DGINC
22 S DGMT=0 F S DGMT=$O(^DGMT(408.21,"AM",DGMT)) Q:'DGMT D
23 .S DGINC=0 F S DGINC=$O(^DGMT(408.21,"AM",DGMT,DGINC)) Q:'DGINC D
24 ..S DA=DGINC,DIE="^DGMT(408.21,",DR="31////@" D ^DIE K DA,DIE,DR
25 K ^DGMT(408.21,"AM")
26 ; Report any errors
27 G:'$D(^TMP("DGMTERR",$J)) GETRELQ
28 W !!,"The following are errors noted in the ANNUAL MEANS TEST file."
29 W !,"The patient is missing from the file (field .02)"
30 N ERR S ERR=0
31 F S ERR=$O(^TMP("DGMTERR",$J,ERR)) Q:'ERR W !,"Means Test Internal File Number: "_ERR
32 K ^TMP("DGMTERR",$J)
33GETRELQ Q
34 ;
35DIE ;Set MT pointer in 408.22
36 ;Delete MT pointer from 408.21
37 S DA=DGIRI,DIE="^DGMT(408.22,",DR="31////"_DGMT D ^DIE K DA,DIE,DR
38 S DA=DGINI,DIE="^DGMT(408.21,",DR="31////@" D ^DIE K DA,DIE,DR
39 Q
Note: See TracBrowser for help on using the repository browser.