source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTAUD1.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1DGMTAUD1 ;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 ;
4D(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
10U(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
16C(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
22SR(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
45S(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
51A(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 ;
58HDR ;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
Note: See TracBrowser for help on using the repository browser.