DGMTAUD1.m

DGMTAUD1 ;ALB/CAW,LD,BRM - Audit Changes to Means Tests - Con't ; 12/20/01 9:07am

 ;;5.3;Registration;**33,166,182,254,300,433,1015**;Aug 13, 1993;Build 21

 ;

D(I) ;Date function

 ;INPUT = Internal value of date

 ;OUTPUT= External value of date

 N DGX,Y

 S Y=I,DGX=$$FMTE^XLFDT(Y,"5F"),DGX=$TR(DGX," ","0")

 Q DGX

U(I) ;User function

 ;INPUT = Internal value (ptr) to NEW PERSON file

 ;OUTPUT= External value of .01 field (person name)

 N DGX

 S DGX=$P($G(^VA(200,+I,0)),U)

 Q DGX

C(I) ;Change type function

 ;INPUT = Internal value (ptr) to MEANS TEST CHANGES TYPE file

 ;OUTPUT= External value of .01 field (change type name)

 N DGX

 S DGX=$P($G(^DG(408.42,+I,0)),U)

 Q DGX

SR(I,DGMTI) ;Get source of test

 ;Input:

 ; I  = zeroth node of test from file #408.31

 ; DGMTI = Annual Means Test file (#408.31) IEN (OPTIONAL)

 ;

 ; Output:

 ;  DGX = external value of .01 field (name of source) OR

 ;        Station name

 ;

 N DGX

 S DGX=$P($G(^DG(408.34,+$P(I,"^",23),0)),U)

 ; check if the source is 'OTHER FACILITY'. If it is derive source

 ; from 'SITE CONDUCTING TEST' field (#2.05) in the Annual Means Test

 ; file (#408.31).

 I DGX="OTHER FACILITY",$D(DGMTI) D

 . N STA

 . ; exclude suffix to get Station # from 'SITE CONDUCTING TEST' field

 . S DGX(1)=$E($$GET1^DIQ(408.31,DGMTI,2.05),1,3)

 . ; get Institution NAME using STATION NUMBER field (#99) in Institution

 . ; file (#4)

 . D FIND^DIC(4,,99,,.DGX,1,"D",,,"STA")

 . S DGX=$G(STA("DILIST",1,1),DGX)

 Q DGX

S(I) ;MT status

 ;INPUT - Internal val of status from 408.31 (ptr to 408.32)

 ;OUTPUT - External val (.01 field)

 N DGX

 S DGX=$P($G(^DG(408.32,+I,0)),U)

 Q DGX

A(I) ;Agree to pay deduct

 ;INPUT - Internal val of agree to pay deduc. fld from file 408.31

 ;OUTPUT - External val of set

 N DGX

 S DGX=$P($G(^DD(408.31,.11,0)),U,3),DGX=$P($P(DGX,I_":",2),";",1)

 Q DGX

 ;

HDR ;Header

 W @IOF,!,"PATIENT: ",$E(DGNAM,1,38),?40,$P("MEANS^COPAY^^LTC EXEMPTION","^",DGMTYPT)_" TEST DATE: ",$$D^DGMTAUD1(DGMTD),!

 W ?40,$$SR^DGMTAUD1($G(^DGMT(408.31,DGMTI,0)))_" "_$P("MEANS^COPAY^^LTC EXEMPTION","^",DGMTYPT)_" TEST",!

 W ?33,"CHANGES",!!

 W ?2,"Date",?23,"Type of Change",?57,"User",!,DGDASH,!

 Q

DGMTAUD1  ;ALB/CAW,LD,BRM - Audit Changes to Means Tests - Con't ; 12/20/01 9:07am

 +1       ;;5.3;Registration;**33,166,182,254,300,433,1015**;Aug 13, 1993;Build 21

 +2       ;

D(I)      ;Date function

 +1       ;INPUT = Internal value of date

 +2       ;OUTPUT= External value of date

 +3        NEW DGX,Y

 +4        SET Y=I

           SET DGX=$$FMTE^XLFDT(Y,"5F")

           SET DGX=$TRANSLATE(DGX," ","0")

 +5        QUIT DGX

U(I)      ;User function

 +1       ;INPUT = Internal value (ptr) to NEW PERSON file

 +2       ;OUTPUT= External value of .01 field (person name)

 +3        NEW DGX

 +4        SET DGX=$PIECE($GET(^VA(200,+I,0)),U)

 +5        QUIT DGX

C(I)      ;Change type function

 +1       ;INPUT = Internal value (ptr) to MEANS TEST CHANGES TYPE file

 +2       ;OUTPUT= External value of .01 field (change type name)

 +3        NEW DGX

 +4        SET DGX=$PIECE($GET(^DG(408.42,+I,0)),U)

 +5        QUIT DGX

SR(I,DGMTI) ;Get source of test

 +1       ;Input:

 +2       ; I  = zeroth node of test from file #408.31

 +3       ; DGMTI = Annual Means Test file (#408.31) IEN (OPTIONAL)

 +4       ;

 +5       ; Output:

 +6       ;  DGX = external value of .01 field (name of source) OR

 +7       ;        Station name

 +8       ;

 +9        NEW DGX

 +10       SET DGX=$PIECE($GET(^DG(408.34,+$PIECE(I,"^",23),0)),U)

 +11      ; check if the source is 'OTHER FACILITY'. If it is derive source

 +12      ; from 'SITE CONDUCTING TEST' field (#2.05) in the Annual Means Test

 +13      ; file (#408.31).

 +14       IF DGX="OTHER FACILITY"

               IF $DATA(DGMTI)

                   Begin DoDot:1

 +15                   NEW STA

 +16      ; exclude suffix to get Station # from 'SITE CONDUCTING TEST' field

 +17                   SET DGX(1)=$EXTRACT($$GET1^DIQ(408.31,DGMTI,2.05),1,3)

 +18      ; get Institution NAME using STATION NUMBER field (#99) in Institution

 +19      ; file (#4)

 +20                   DO FIND^DIC(4,,99,,.DGX,1,"D",,,"STA")

 +21                   SET DGX=$GET(STA("DILIST",1,1),DGX)

                   End DoDot:1

 +22       QUIT DGX

S(I)      ;MT status

 +1       ;INPUT - Internal val of status from 408.31 (ptr to 408.32)

 +2       ;OUTPUT - External val (.01 field)

 +3        NEW DGX

 +4        SET DGX=$PIECE($GET(^DG(408.32,+I,0)),U)

 +5        QUIT DGX

A(I)      ;Agree to pay deduct

 +1       ;INPUT - Internal val of agree to pay deduc. fld from file 408.31

 +2       ;OUTPUT - External val of set

 +3        NEW DGX

 +4        SET DGX=$PIECE($GET(^DD(408.31,.11,0)),U,3)

           SET DGX=$PIECE($PIECE(DGX,I_":",2),";",1)

 +5        QUIT DGX

 +6       ;

HDR       ;Header

 +1        WRITE @IOF,!,"PATIENT: ",$EXTRACT(DGNAM,1,38),?40,$PIECE("MEANS^COPAY^^LTC EXEMPTION","^",DGMTYPT)_" TEST DATE: ",$$D^DGMTAUD1(DGMTD),!

 +2        WRITE ?40,$$SR^DGMTAUD1($GET(^DGMT(408.31,DGMTI,0)))_" "_$PIECE("MEANS^COPAY^^LTC EXEMPTION","^",DGMTYPT)_" TEST",!

 +3        WRITE ?33,"CHANGES",!!

 +4        WRITE ?2,"Date",?23,"Type of Change",?57,"User",!,DGDASH,!

 +5        QUIT