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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1DGMSTR4 ;ALB/SCK - MST History report ; 7/9/01 4:07pm
2 ;;5.3;Registration;**195,379**;Aug 13, 1993
3EN ; Main entry point
4 N VAUTN,VAUTNI,VA,Y,ZTSAVE
5 ;
6 ; Select patients to include
7 S VAUTNI=0
8 D PATIENT^VAUTOMA
9 I '$G(VAUTN),$O(VAUTN(""))="" Q
10 ;
11 N ZTSAVE
12 S ZTSAVE("VAUTN")=""
13 D EN^XUTMDEVQ("RPT^DGMSTR4","MST History Report",.ZTSAVE)
14 D HOME^%ZIS
15 Q
16 ;
17RPT ; Generate and print report
18 N RPTREF,MSTNAME,DFN,DGQUIT,FRSTPAS
19 ;
20 S RPTREF="^TMP(""MST RPT"","_$J_")"
21 K @RPTREF
22 D BUILD(.VAUTN,RPTREF)
23 Q:$$HEADER
24 ;
25 ; Print report from contents of ^TMP global
26 ; If not data found, then print message on form.
27 I '$D(@RPTREF) D Q
28 . W !?2,"No data found for report."
29 ;
30 S MSTNAME=""
31 F S MSTNAME=$O(@RPTREF@(MSTNAME)) Q:'(MSTNAME]"") D Q:$G(DGQUIT)
32 . S DFN=$P(MSTNAME,U,2)
33 . D PID^VADPT
34 . W !?2,$E($P(MSTNAME,U),1,$L($P(MSTNAME,U)))," ("_VA("PID")_")"
35 . S MSTDT=""
36 . F S MSTDT=($O(@RPTREF@(MSTNAME,MSTDT))) Q:'MSTDT D Q:$G(DGQUIT)
37 .. S DGMST=@RPTREF@(MSTNAME,MSTDT)
38 .. W !?2,$$FMTE^XLFDT(-MSTDT)
39 .. W ?21,$J($P(DGMST,U,2),2)
40 .. W ?30,$$GET1^DIQ(4,(+$P(DGMST,U,7))_",",99)
41 .. W ?36,$E($$NAME^DGMSTAPI($P(DGMST,U,4)),1,25)
42 .. W ?61,$E($$NAME^DGMSTAPI($P(DGMST,U,5)),1,25)
43 . W !
44 . I $Y+5>$G(IOSL) D Q:$G(DGQUIT)
45 .. S DGQUIT=$$HEADER
46 ;
47 D KVA^VADPT
48 K @RPTREF
49 Q
50 ;
51BUILD(PTARRY,RPARRY) ; Build TMP global of patients to include in report form array
52 ; of patient names passed in (PTARRY)
53 ;
54 N DFN,MSTDT,DGMST,MSTIEN
55 ;
56 S DFN=""
57 F S DFN=$O(^DGMS(29.11,"APDT",DFN)) Q:'DFN D
58 . I 'PTARRY,'$D(PTARRY(DFN)) Q
59 . S MSTDT=""
60 . F S MSTDT=$O(^DGMS(29.11,"APDT",DFN,MSTDT),-1) Q:'MSTDT D
61 .. S DGMST=$$GETSTAT^DGMSTAPI(DFN,MSTDT)
62 .. Q:+DGMST<1
63 .. S @RPARRY@($P(^DPT(DFN,0),U)_U_DFN,-MSTDT)=DGMST
64 Q
65 ;
66HEADER() ; Print report header
67 N SDASH,LINE,STR
68 I $G(FRSTPAS),$E(IOST,1,2)="C-" D PAUSE^VALM1 Q:'Y 1
69 I '$G(FRSTPAS) D
70 . S FRSTPAS=1
71 . W @IOF
72 E D
73 . W @IOF
74 S STR="MST HISTORY REPORT"
75 S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
76 W !,LINE_STR
77 S STR="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT,"D")
78 K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
79 W !,LINE_STR
80 ;
81 W !!?2,"Status Date",?21,"Status",?30,"Site",?36,"Provider",?61,"Who entered status",!
82 S $P(SDASH,"-",IOM+1)=""
83 W SDASH,!
84 Q 0
Note: See TracBrowser for help on using the repository browser.