DGMSTR4 ;ALB/SCK - MST History report ; 7/9/01 4:07pm
;;5.3;Registration;**195,379**;Aug 13, 1993
EN ; Main entry point
N VAUTN,VAUTNI,VA,Y,ZTSAVE
;
; Select patients to include
S VAUTNI=0
D PATIENT^VAUTOMA
I '$G(VAUTN),$O(VAUTN(""))="" Q
;
N ZTSAVE
S ZTSAVE("VAUTN")=""
D EN^XUTMDEVQ("RPT^DGMSTR4","MST History Report",.ZTSAVE)
D HOME^%ZIS
Q
;
RPT ; Generate and print report
N RPTREF,MSTNAME,DFN,DGQUIT,FRSTPAS
;
S RPTREF="^TMP(""MST RPT"","_$J_")"
K @RPTREF
D BUILD(.VAUTN,RPTREF)
Q:$$HEADER
;
; Print report from contents of ^TMP global
; If not data found, then print message on form.
I '$D(@RPTREF) D Q
. W !?2,"No data found for report."
;
S MSTNAME=""
F S MSTNAME=$O(@RPTREF@(MSTNAME)) Q:'(MSTNAME]"") D Q:$G(DGQUIT)
. S DFN=$P(MSTNAME,U,2)
. D PID^VADPT
. W !?2,$E($P(MSTNAME,U),1,$L($P(MSTNAME,U)))," ("_VA("PID")_")"
. S MSTDT=""
. F S MSTDT=($O(@RPTREF@(MSTNAME,MSTDT))) Q:'MSTDT D Q:$G(DGQUIT)
.. S DGMST=@RPTREF@(MSTNAME,MSTDT)
.. W !?2,$$FMTE^XLFDT(-MSTDT)
.. W ?21,$J($P(DGMST,U,2),2)
.. W ?30,$$GET1^DIQ(4,(+$P(DGMST,U,7))_",",99)
.. W ?36,$E($$NAME^DGMSTAPI($P(DGMST,U,4)),1,25)
.. W ?61,$E($$NAME^DGMSTAPI($P(DGMST,U,5)),1,25)
. W !
. I $Y+5>$G(IOSL) D Q:$G(DGQUIT)
.. S DGQUIT=$$HEADER
;
D KVA^VADPT
K @RPTREF
Q
;
BUILD(PTARRY,RPARRY) ; Build TMP global of patients to include in report form array
; of patient names passed in (PTARRY)
;
N DFN,MSTDT,DGMST,MSTIEN
;
S DFN=""
F S DFN=$O(^DGMS(29.11,"APDT",DFN)) Q:'DFN D
. I 'PTARRY,'$D(PTARRY(DFN)) Q
. S MSTDT=""
. F S MSTDT=$O(^DGMS(29.11,"APDT",DFN,MSTDT),-1) Q:'MSTDT D
.. S DGMST=$$GETSTAT^DGMSTAPI(DFN,MSTDT)
.. Q:+DGMST<1
.. S @RPARRY@($P(^DPT(DFN,0),U)_U_DFN,-MSTDT)=DGMST
Q
;
N SDASH,LINE,STR
I $G(FRSTPAS),$E(IOST,1,2)="C-" D PAUSE^VALM1 Q:'Y 1
I '$G(FRSTPAS) D
. S FRSTPAS=1
. W @IOF
E D
. W @IOF
S STR="MST HISTORY REPORT"
S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
W !,LINE_STR
S STR="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT,"D")
K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
W !,LINE_STR
;
W !!?2,"Status Date",?21,"Status",?30,"Site",?36,"Provider",?61,"Who entered status",!
S $P(SDASH,"-",IOM+1)=""
W SDASH,!
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMSTR4 2303 printed Oct 16, 2024@18:45:10 Page 2
DGMSTR4 ;ALB/SCK - MST History report ; 7/9/01 4:07pm
+1 ;;5.3;Registration;**195,379**;Aug 13, 1993
EN ; Main entry point
+1 NEW VAUTN,VAUTNI,VA,Y,ZTSAVE
+2 ;
+3 ; Select patients to include
+4 SET VAUTNI=0
+5 DO PATIENT^VAUTOMA
+6 IF '$GET(VAUTN)
IF $ORDER(VAUTN(""))=""
QUIT
+7 ;
+8 NEW ZTSAVE
+9 SET ZTSAVE("VAUTN")=""
+10 DO EN^XUTMDEVQ("RPT^DGMSTR4","MST History Report",.ZTSAVE)
+11 DO HOME^%ZIS
+12 QUIT
+13 ;
RPT ; Generate and print report
+1 NEW RPTREF,MSTNAME,DFN,DGQUIT,FRSTPAS
+2 ;
+3 SET RPTREF="^TMP(""MST RPT"","_$JOB_")"
+4 KILL @RPTREF
+5 DO BUILD(.VAUTN,RPTREF)
+6 if $$HEADER
QUIT
+7 ;
+8 ; Print report from contents of ^TMP global
+9 ; If not data found, then print message on form.
+10 IF '$DATA(@RPTREF)
Begin DoDot:1
+11 WRITE !?2,"No data found for report."
End DoDot:1
QUIT
+12 ;
+13 SET MSTNAME=""
+14 FOR
SET MSTNAME=$ORDER(@RPTREF@(MSTNAME))
if '(MSTNAME]"")
QUIT
Begin DoDot:1
+15 SET DFN=$PIECE(MSTNAME,U,2)
+16 DO PID^VADPT
+17 WRITE !?2,$EXTRACT($PIECE(MSTNAME,U),1,$LENGTH($PIECE(MSTNAME,U)))," ("_VA("PID")_")"
+18 SET MSTDT=""
+19 FOR
SET MSTDT=($ORDER(@RPTREF@(MSTNAME,MSTDT)))
if 'MSTDT
QUIT
Begin DoDot:2
+20 SET DGMST=@RPTREF@(MSTNAME,MSTDT)
+21 WRITE !?2,$$FMTE^XLFDT(-MSTDT)
+22 WRITE ?21,$JUSTIFY($PIECE(DGMST,U,2),2)
+23 WRITE ?30,$$GET1^DIQ(4,(+$PIECE(DGMST,U,7))_",",99)
+24 WRITE ?36,$EXTRACT($$NAME^DGMSTAPI($PIECE(DGMST,U,4)),1,25)
+25 WRITE ?61,$EXTRACT($$NAME^DGMSTAPI($PIECE(DGMST,U,5)),1,25)
End DoDot:2
if $GET(DGQUIT)
QUIT
+26 WRITE !
+27 IF $Y+5>$GET(IOSL)
Begin DoDot:2
+28 SET DGQUIT=$$HEADER
End DoDot:2
if $GET(DGQUIT)
QUIT
End DoDot:1
if $GET(DGQUIT)
QUIT
+29 ;
+30 DO KVA^VADPT
+31 KILL @RPTREF
+32 QUIT
+33 ;
BUILD(PTARRY,RPARRY) ; Build TMP global of patients to include in report form array
+1 ; of patient names passed in (PTARRY)
+2 ;
+3 NEW DFN,MSTDT,DGMST,MSTIEN
+4 ;
+5 SET DFN=""
+6 FOR
SET DFN=$ORDER(^DGMS(29.11,"APDT",DFN))
if 'DFN
QUIT
Begin DoDot:1
+7 IF 'PTARRY
IF '$DATA(PTARRY(DFN))
QUIT
+8 SET MSTDT=""
+9 FOR
SET MSTDT=$ORDER(^DGMS(29.11,"APDT",DFN,MSTDT),-1)
if 'MSTDT
QUIT
Begin DoDot:2
+10 SET DGMST=$$GETSTAT^DGMSTAPI(DFN,MSTDT)
+11 if +DGMST<1
QUIT
+12 SET @RPARRY@($PIECE(^DPT(DFN,0),U)_U_DFN,-MSTDT)=DGMST
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
+1 NEW SDASH,LINE,STR
+2 IF $GET(FRSTPAS)
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
if 'Y
QUIT 1
+3 IF '$GET(FRSTPAS)
Begin DoDot:1
+4 SET FRSTPAS=1
+5 WRITE @IOF
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 WRITE @IOF
End DoDot:1
+8 SET STR="MST HISTORY REPORT"
+9 SET $PIECE(LINE," ",(IOM/2)-($LENGTH(STR)/2))=""
+10 WRITE !,LINE_STR
+11 SET STR="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT,"D")
+12 KILL LINE
SET $PIECE(LINE," ",(IOM/2)-($LENGTH(STR)/2))=""
+13 WRITE !,LINE_STR
+14 ;
+15 WRITE !!?2,"Status Date",?21,"Status",?30,"Site",?36,"Provider",?61,"Who entered status",!
+16 SET $PIECE(SDASH,"-",IOM+1)=""
+17 WRITE SDASH,!
+18 QUIT 0
