- 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
