| [613] | 1 | DGMTAUD1 ;ALB/CAW,LD,BRM - Audit Changes to Means Tests - Con't ; 12/20/01 9:07am
|
|---|
| 2 | ;;5.3;Registration;**33,166,182,254,300,433**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | D(I) ;Date function
|
|---|
| 5 | ;INPUT = Internal value of date
|
|---|
| 6 | ;OUTPUT= External value of date
|
|---|
| 7 | N DGX,Y
|
|---|
| 8 | S Y=I,DGX=$$FMTE^XLFDT(Y,"5F"),DGX=$TR(DGX," ","0")
|
|---|
| 9 | Q DGX
|
|---|
| 10 | U(I) ;User function
|
|---|
| 11 | ;INPUT = Internal value (ptr) to NEW PERSON file
|
|---|
| 12 | ;OUTPUT= External value of .01 field (person name)
|
|---|
| 13 | N DGX
|
|---|
| 14 | S DGX=$P($G(^VA(200,+I,0)),U)
|
|---|
| 15 | Q DGX
|
|---|
| 16 | C(I) ;Change type function
|
|---|
| 17 | ;INPUT = Internal value (ptr) to MEANS TEST CHANGES TYPE file
|
|---|
| 18 | ;OUTPUT= External value of .01 field (change type name)
|
|---|
| 19 | N DGX
|
|---|
| 20 | S DGX=$P($G(^DG(408.42,+I,0)),U)
|
|---|
| 21 | Q DGX
|
|---|
| 22 | SR(I,DGMTI) ;Get source of test
|
|---|
| 23 | ;Input:
|
|---|
| 24 | ; I = zeroth node of test from file #408.31
|
|---|
| 25 | ; DGMTI = Annual Means Test file (#408.31) IEN (OPTIONAL)
|
|---|
| 26 | ;
|
|---|
| 27 | ; Output:
|
|---|
| 28 | ; DGX = external value of .01 field (name of source) OR
|
|---|
| 29 | ; Station name
|
|---|
| 30 | ;
|
|---|
| 31 | N DGX
|
|---|
| 32 | S DGX=$P($G(^DG(408.34,+$P(I,"^",23),0)),U)
|
|---|
| 33 | ; check if the source is 'OTHER FACILITY'. If it is derive source
|
|---|
| 34 | ; from 'SITE CONDUCTING TEST' field (#2.05) in the Annual Means Test
|
|---|
| 35 | ; file (#408.31).
|
|---|
| 36 | I DGX="OTHER FACILITY",$D(DGMTI) D
|
|---|
| 37 | . N STA
|
|---|
| 38 | . ; exclude suffix to get Station # from 'SITE CONDUCTING TEST' field
|
|---|
| 39 | . S DGX(1)=$E($$GET1^DIQ(408.31,DGMTI,2.05),1,3)
|
|---|
| 40 | . ; get Institution NAME using STATION NUMBER field (#99) in Institution
|
|---|
| 41 | . ; file (#4)
|
|---|
| 42 | . D FIND^DIC(4,,99,,.DGX,1,"D",,,"STA")
|
|---|
| 43 | . S DGX=$G(STA("DILIST",1,1),DGX)
|
|---|
| 44 | Q DGX
|
|---|
| 45 | S(I) ;MT status
|
|---|
| 46 | ;INPUT - Internal val of status from 408.31 (ptr to 408.32)
|
|---|
| 47 | ;OUTPUT - External val (.01 field)
|
|---|
| 48 | N DGX
|
|---|
| 49 | S DGX=$P($G(^DG(408.32,+I,0)),U)
|
|---|
| 50 | Q DGX
|
|---|
| 51 | A(I) ;Agree to pay deduct
|
|---|
| 52 | ;INPUT - Internal val of agree to pay deduc. fld from file 408.31
|
|---|
| 53 | ;OUTPUT - External val of set
|
|---|
| 54 | N DGX
|
|---|
| 55 | S DGX=$P($G(^DD(408.31,.11,0)),U,3),DGX=$P($P(DGX,I_":",2),";",1)
|
|---|
| 56 | Q DGX
|
|---|
| 57 | ;
|
|---|
| 58 | HDR ;Header
|
|---|
| 59 | W @IOF,!,"PATIENT: ",$E(DGNAM,1,38),?40,$P("MEANS^COPAY^^LTC EXEMPTION","^",DGMTYPT)_" TEST DATE: ",$$D^DGMTAUD1(DGMTD),!
|
|---|
| 60 | W ?40,$$SR^DGMTAUD1($G(^DGMT(408.31,DGMTI,0)))_" "_$P("MEANS^COPAY^^LTC EXEMPTION","^",DGMTYPT)_" TEST",!
|
|---|
| 61 | W ?33,"CHANGES",!!
|
|---|
| 62 | W ?2,"Date",?23,"Type of Change",?57,"User",!,DGDASH,!
|
|---|
| 63 | Q
|
|---|
