- DGMSTR4 ;ALB/SCK - MST History report ; 7/9/01 4:07pm
- ;;5.3;Registration;**195,379,1015**;Aug 13, 1993;Build 21
- 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
- DGMSTR4 ;ALB/SCK - MST History report ; 7/9/01 4:07pm
- +1 ;;5.3;Registration;**195,379,1015**;Aug 13, 1993;Build 21
- 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
