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**;Aug 13, 1993
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTAUD1 2205 printed Dec 13, 2024@02:44:36 Page 2
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**;Aug 13, 1993
+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
