DGYRCOV ;ALB/CAW - Convert MT pointer from 408.21 to 408.22;10/27/94
;;5.3;Registration;**45**;Aug 13, 1993
;
GETREL ; Get all active relations for that year
N CNT,DEP,DGDATE,DGERR,DGMT,DGINC,DGINI,DGIRI,DGMTI,DGREL,DFN,DATE,INC,INR,FLAG,FLAG1
S (DGMT,CNT)=0
F S DGMT=$O(^DGMT(408.31,DGMT)) Q:'DGMT S DGMTI=^(DGMT,0) D
.S CNT=CNT+1
.K FLAG
.I '$P(DGMTI,U)!'$P(DGMTI,U,2) S ^TMP("DGMTERR",$J,DGMT)="" Q
.S DFN=$P(DGMTI,U,2)
.S DATE=$P(DGMTI,U)
.D GETREL^DGMTU11(DFN,"VSC",DATE) Q:'$G(DGREL("V"))
.D GETIENS^DGMTU2(DFN,+DGREL("V"),DATE) I $G(DGINI),$G(DGIRI) D DIE
.I $G(DGREL("S")) D GETIENS^DGMTU2(DFN,+DGREL("S"),DATE) I $G(DGINI),$G(DGIRI) D DIE
.S DEP=0 F S DEP=$O(DGREL("C",DEP)) Q:'DEP D
..D GETIENS^DGMTU2(DFN,+DGREL("C",DEP),DATE) I $G(DGINI),$G(DGIRI) D DIE
.I '(CNT#100) W "."
;
; Fix any remaining pointers
N DGMT,DGINC
S DGMT=0 F S DGMT=$O(^DGMT(408.21,"AM",DGMT)) Q:'DGMT D
.S DGINC=0 F S DGINC=$O(^DGMT(408.21,"AM",DGMT,DGINC)) Q:'DGINC D
..S DA=DGINC,DIE="^DGMT(408.21,",DR="31////@" D ^DIE K DA,DIE,DR
K ^DGMT(408.21,"AM")
; Report any errors
G:'$D(^TMP("DGMTERR",$J)) GETRELQ
W !!,"The following are errors noted in the ANNUAL MEANS TEST file."
W !,"The patient is missing from the file (field .02)"
N ERR S ERR=0
F S ERR=$O(^TMP("DGMTERR",$J,ERR)) Q:'ERR W !,"Means Test Internal File Number: "_ERR
K ^TMP("DGMTERR",$J)
GETRELQ Q
;
DIE ;Set MT pointer in 408.22
;Delete MT pointer from 408.21
S DA=DGIRI,DIE="^DGMT(408.22,",DR="31////"_DGMT D ^DIE K DA,DIE,DR
S DA=DGINI,DIE="^DGMT(408.21,",DR="31////@" D ^DIE K DA,DIE,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYRCOV 1626 printed Nov 22, 2024@18:10:38 Page 2
DGYRCOV ;ALB/CAW - Convert MT pointer from 408.21 to 408.22;10/27/94
+1 ;;5.3;Registration;**45**;Aug 13, 1993
+2 ;
GETREL ; Get all active relations for that year
+1 NEW CNT,DEP,DGDATE,DGERR,DGMT,DGINC,DGINI,DGIRI,DGMTI,DGREL,DFN,DATE,INC,INR,FLAG,FLAG1
+2 SET (DGMT,CNT)=0
+3 FOR
SET DGMT=$ORDER(^DGMT(408.31,DGMT))
if 'DGMT
QUIT
SET DGMTI=^(DGMT,0)
Begin DoDot:1
+4 SET CNT=CNT+1
+5 KILL FLAG
+6 IF '$PIECE(DGMTI,U)!'$PIECE(DGMTI,U,2)
SET ^TMP("DGMTERR",$JOB,DGMT)=""
QUIT
+7 SET DFN=$PIECE(DGMTI,U,2)
+8 SET DATE=$PIECE(DGMTI,U)
+9 DO GETREL^DGMTU11(DFN,"VSC",DATE)
if '$GET(DGREL("V"))
QUIT
+10 DO GETIENS^DGMTU2(DFN,+DGREL("V"),DATE)
IF $GET(DGINI)
IF $GET(DGIRI)
DO DIE
+11 IF $GET(DGREL("S"))
DO GETIENS^DGMTU2(DFN,+DGREL("S"),DATE)
IF $GET(DGINI)
IF $GET(DGIRI)
DO DIE
+12 SET DEP=0
FOR
SET DEP=$ORDER(DGREL("C",DEP))
if 'DEP
QUIT
Begin DoDot:2
+13 DO GETIENS^DGMTU2(DFN,+DGREL("C",DEP),DATE)
IF $GET(DGINI)
IF $GET(DGIRI)
DO DIE
End DoDot:2
+14 IF '(CNT#100)
WRITE "."
End DoDot:1
+15 ;
+16 ; Fix any remaining pointers
+17 NEW DGMT,DGINC
+18 SET DGMT=0
FOR
SET DGMT=$ORDER(^DGMT(408.21,"AM",DGMT))
if 'DGMT
QUIT
Begin DoDot:1
+19 SET DGINC=0
FOR
SET DGINC=$ORDER(^DGMT(408.21,"AM",DGMT,DGINC))
if 'DGINC
QUIT
Begin DoDot:2
+20 SET DA=DGINC
SET DIE="^DGMT(408.21,"
SET DR="31////@"
DO ^DIE
KILL DA,DIE,DR
End DoDot:2
End DoDot:1
+21 KILL ^DGMT(408.21,"AM")
+22 ; Report any errors
+23 if '$DATA(^TMP("DGMTERR",$JOB))
GOTO GETRELQ
+24 WRITE !!,"The following are errors noted in the ANNUAL MEANS TEST file."
+25 WRITE !,"The patient is missing from the file (field .02)"
+26 NEW ERR
SET ERR=0
+27 FOR
SET ERR=$ORDER(^TMP("DGMTERR",$JOB,ERR))
if 'ERR
QUIT
WRITE !,"Means Test Internal File Number: "_ERR
+28 KILL ^TMP("DGMTERR",$JOB)
GETRELQ QUIT
+1 ;
DIE ;Set MT pointer in 408.22
+1 ;Delete MT pointer from 408.21
+2 SET DA=DGIRI
SET DIE="^DGMT(408.22,"
SET DR="31////"_DGMT
DO ^DIE
KILL DA,DIE,DR
+3 SET DA=DGINI
SET DIE="^DGMT(408.21,"
SET DR="31////@"
DO ^DIE
KILL DA,DIE,DR
+4 QUIT
