DGYRCOV.m

DGYRCOV ;ALB/CAW - Convert MT pointer from 408.21 to 408.22;10/27/94

 ;;5.3;Registration;**45,1015**;Aug 13, 1993;Build 21

 ;

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

DGYRCOV   ;ALB/CAW - Convert MT pointer from 408.21 to 408.22;10/27/94

 +1       ;;5.3;Registration;**45,1015**;Aug 13, 1993;Build 21

 +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