Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPHSTAT

DGPHSTAT.m

Go to the documentation of this file. 
  1. DGPHSTAT ;ALB/RPM - PURPLE HEART STATUS REPORT ; 02/01/01 8:00am
  1.  ;;5.3;Registration;**343**;Aug 13, 1993
  1.  ;
  1.  ;This report lists all patients with Current PH Status of either
  1.  ;In Process or Pending.  The report can be tasked using TaskMan
  1.  ;and the EN^DGPHSTAT entry point.  The Purple Heart Sort field (#1202)
  1.  ;of the MAS PARAMETERS file (#43) contains the sort order used
  1.  ;when queuing from TaskMan.  The option allows manual
  1.  ;generation of the report using a user selected sort order and
  1.  ;output device.
  1.  ;
  1.  Q   ;No direct entry
  1.  ;
  1. EN ;Entry point
  1.  I '$D(ZTQUEUED) D MAN Q
  1.  ;
  1. QEN ;Start point for TaskMan queuing
  1.  N DGORD
  1.  ;
  1.  ;Retrieve the sort order in numeric: 1-"A"scending or 0-"D"escending
  1.  S DGORD=$$GETSORT("N")
  1.  D START
  1.  Q
  1.  ;
  1. MAN ;Start point for manual report allows sort order and device selection
  1.  N DGORD
  1.  S DGORD=$$ASKSORT()
  1.  Q:DGORD=-1
  1.  I $$DEVICE() D START
  1.  Q
  1.  ;
  1. ASKSORT() ;Requests sort order from user when MAN entry point
  1.  ; Input: none
  1.  ;
  1.  ; Output: Function value   Interpretation
  1.  ;               0            Descending
  1.  ;               1            Ascending
  1.  ;              -1            "^" or timeout
  1.  ;
  1.  N DGSORT,DIR,DIRUT,DTOUT
  1.  S DIR(0)="SA^D:DESCENDING;A:ASCENDING"
  1.  S DIR("A")="Select 'A'scending or 'D'escending format: "
  1.  S DIR("A",1)="The Purple Heart Status report will be sorted by number of days"
  1.  S DIR("A",2)="since the last Status change in ascending or descending order."
  1.  S DIR("A",3)=""
  1.  S DIR("B")=$$GETSORT("E")
  1.  S DIR("?")="Report will be sorted by number of days since last update."
  1.  S DIR("??")="Enter 'A' if you want most recent first, 'D' if oldest first."
  1.  W !!
  1.  D ^DIR
  1.  S DGSORT=$S(Y="A":1,1:0)
  1.  I $D(DIRUT)!$D(DTOUT) S DGSORT=-1
  1.  Q DGSORT
  1.  ;
  1. DEVICE() ;Allow user selection of output device
  1.  ; Input: none
  1.  ;
  1.  ; Output: Function value    Interpretation
  1.  ;               0           User decides to queue or not print report. 
  1.  ;               1           Device selected to generate report NOW. 
  1.  ;
  1.  N OK,IOP,POP,%ZIS
  1.  S OK=1
  1.  S %ZIS="MQ"
  1.  D ^%ZIS
  1.  S:POP OK=0
  1.  I OK,$D(IO("Q")) D
  1.  . N ZTRTN,ZTDESC,ZTSAVE,ZTSK
  1.  . S ZTRTN="START^DGPHSTAT"
  1.  . S ZTDESC="Current PH Status Pending/In Process report."
  1.  . S ZTSAVE("DGORD")=""
  1.  . F DG1=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
  1.  . W !,$S($D(ZTSK):"Request "_ZTSK_" Queued!",1:"Request Cancelled!"),!
  1.  . D HOME^%ZIS
  1.  . S OK=0
  1.  Q OK
  1.  ;
  1. START ;
  1.  D LOOP
  1.  D PRINT
  1.  D EXIT
  1.  Q
  1.  ;
  1. LOOP ;Locate all PENDING and IN-PROCESS status Purple Heart requests
  1.  ;and build ^TMP("DGPH",$J, with data
  1.  N DGSTAT  ;Purple Heart Status
  1.  N DGDFN   ;Patient DFN
  1.  K ^TMP("DGPH",$J)
  1.  F DGSTAT=1,2 D
  1.  . S DGDFN=0
  1.  . F  S DGDFN=$O(^DPT("C",DGSTAT,DGDFN)) Q:'DGDFN  D
  1.  . . D BLDTMP(DGSTAT,DGDFN,DGORD)
  1.  Q
  1.  ;
  1. BLDTMP(DGST,DFN,DGOR) ;^TMP("DGPH",$J global builder
  1.  ; Build TMP file based on sort selection
  1.  ;
  1.  ; Division name retrieved from pointer to the INSTITUTION file (#4)
  1.  ; in PH DIVISION field (#.535) in PATIENT file (#2)
  1.  ; DBIA: #10090 - Supported read to the INSTITUTION file with FileMan
  1.  ;
  1.  ; Input:
  1.  ;    DGST - PH Status
  1.  ;    DFN  - Patient
  1.  ;    DGOR - Sort Order [default=0 (Descending)]
  1.  ;
  1.  N DGDAYS,DGDIV,DGDT,DGNAME,DGNUM,DGSSN,VADM,X,X1,X2,Y
  1.  ;validate input parameters
  1.  I $G(DGST)'=1,$G(DGST)'=2 Q
  1.  Q:'$G(DFN)
  1.  S DGOR=$G(DGOR,0)
  1.  ;
  1.  D ^VADPT
  1.  S DGNAME=VADM(1)
  1.  S DGSSN=$P(VADM(2),U,2)
  1.  S DGNUM=$O(^DPT(DFN,"PH"," "),-1)
  1.  Q:DGNUM=""
  1.  S DGDT=$P(^DPT(DFN,"PH",DGNUM,0),U)
  1.  S X1=DT,X2=DGDT D ^%DTC S DGDAYS=X
  1.  S Y=DGDT D DD^%DT S DGDT=Y
  1.  S DGDIV=$$GET1^DIQ(2,DFN,.535)
  1.  I $G(DGDIV)']"" S DGDIV="UNKNOWN"
  1.  S ^TMP("DGPH",$J,"REQ",DGDIV,DGST,$S(DGOR:DGDAYS,1:(999-DGDAYS)),DFN)=DGDAYS_"^"_DGDT_"^"_DGNAME_"^"_DGSSN
  1.  S ^TMP("DGPH",$J,"TOT")=$G(^TMP("DGPH",$J,"TOT"))+1
  1.  S ^TMP("DGPH",$J,"STAT",DGST)=$G(^TMP("DGPH",$J,"STAT",DGST))+1
  1.  S ^TMP("DGPH",$J,"DIV",DGDIV)=$G(^TMP("DGPH",$J,"DIV",DGDIV))+1
  1.  Q
  1.  ;
  1. PRINT ;
  1.  U IO
  1.  N DG1,DG2,DG3,DG4,DGFIRST,DGLINE
  1.  N DGSITE,DGSTNUM,DGSTTN,DGSTN
  1.  N DGQUIT,DGPAGE
  1.  S DGSITE=$$SITE^VASITE
  1.  S DGSTNUM=$P(DGSITE,U,3),DGSTN=$P(DGSITE,U,2)
  1.  S DGSTTN=$$NAME^VASITE(DT)
  1.  S DGSTN=$S($G(DGSTTN)]"":DGSTTN,1:$G(DGSTN))
  1.  S DGQUIT=0
  1.  S DGPAGE=0
  1.  I '$D(^TMP("DGPH",$J)) D  Q
  1.  . D HEAD
  1.  . W !!!?20,"**** No records to report. ****"
  1.  S DG1=""
  1.  F  S DG1=$O(^TMP("DGPH",$J,"REQ",DG1)) Q:DG1']""  D  Q:DGQUIT
  1.  . D HEAD
  1.  . Q:DGQUIT
  1.  . W !,"Division: "_DG1
  1.  . S DG2=0
  1.  . F  S DG2=$O(^TMP("DGPH",$J,"REQ",DG1,DG2)) Q:'DG2  D  Q:DGQUIT
  1.  . . W !!,"DAYS",?13,"DATE"
  1.  . . W !,$S(DG2="1":"PENDING",1:"IN PROCESS"),?13,$S(DG2="1":"PENDING",1:"IN PROCESS"),?36,"PATIENT NAME",?67,"PATIENT SSN"
  1.  . . W !,"----------",?13,"----------",?36,"------------",?67,"-----------"
  1.  . . S DG3=""
  1.  . . F  S DG3=$O(^TMP("DGPH",$J,"REQ",DG1,DG2,DG3)) Q:DG3=""  D  Q:DGQUIT
  1.  . . . S DG4=0
  1.  . . . F  S DG4=$O(^TMP("DGPH",$J,"REQ",DG1,DG2,DG3,DG4)) Q:'DG4  D  Q:DGQUIT
  1.  . . . . D:$Y>(IOSL-4) HEAD Q:DGQUIT
  1.  . . . . S DGLINE=^TMP("DGPH",$J,"REQ",DG1,DG2,DG3,DG4)
  1.  . . . . W !,$P($G(DGLINE),U),?13,$P($G(DGLINE),U,2),?36,$P($G(DGLINE),U,3),?67,$P($G(DGLINE),U,4)
  1.  . Q:DGQUIT
  1.  . W !!?5,"Requests from Division "_DG1_": "_^TMP("DGPH",$J,"DIV",DG1)
  1.  ;Shutdown if stop task requested
  1.  I DGQUIT W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
  1.  ;
  1.  W !!?7,"Total Number of Pending: "_$S($G(^TMP("DGPH",$J,"STAT","1"))>0:^TMP("DGPH",$J,"STAT","1"),1:0)
  1.  W !?5,"Total Number of In Process Requests: "_$S($G(^TMP("DGPH",$J,"STAT","2"))>0:^TMP("DGPH",$J,"STAT","2"),1:0)
  1.  W !?5,"Total Number of Outstanding Requests: "_$G(^TMP("DGPH",$J,"TOT"))
  1.  Q
  1.  ;
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q
  1.  I $G(DGPAGE)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1
  1.  Q:DGQUIT
  1.  W @IOF
  1.  S Y=DT X ^DD("DD") S DGDT=Y
  1.  S DGPAGE=$G(DGPAGE)+1
  1.  W !,"PURPLE HEART REQUEST STATUS REPORT",?48,DGDT,?70,"Page: ",$G(DGPAGE)
  1.  W !,"STATION: "_$G(DGSTN)
  1.  Q
  1.  ;
  1. GETSORT(DGFMT) ;Retrieve the sort order from field 1202 of MAS PARAMETERS file
  1.  ; Input:   DGFMT - selects output format
  1.  ;                  Valid values: "N" - numeric [default]
  1.  ;                                "I" - internal FM
  1.  ;                                "E" - external FM  
  1.  ;
  1.  ; Output:  Function value   Interpretation
  1.  ;                 0          Descending order [default] when "N" input
  1.  ;                 1          Ascending order when "N" input
  1.  ;                "D"         Descending order when "I" input
  1.  ;                "A"         Ascending order when "I" input
  1.  ;           "DESCENDING"     Descending order when "E" input
  1.  ;           "ASCENDING"      Ascending order when "E" input
  1.  ;
  1.  N DGSORT,DGFLG
  1.  S DGFMT=$G(DGFMT,"N")
  1.  I DGFMT'="N",DGFMT'="I",DGFMT'="E" S DGFMT="N"
  1.  S DGFLG=$S(DGFMT="I":"I",DGFMT="E":"E",1:"I")
  1.  S DGSORT=$$GET1^DIQ(43,"1,",1202,DGFLG)
  1.  I DGFMT="N" S DGSORT=$S(DGSORT="A":1,1:0)
  1.  I DGFMT="I" S DGSORT=$S(DGSORT'="":DGSORT,1:"D")
  1.  I DGFMT="E" S DGSORT=$S(DGSORT'="":DGSORT,1:"DESCENDING")
  1.  Q DGSORT
  1.  ;
  1. EXIT ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  K ^TMP("DGPH",$J)
  1.  I '$D(ZTQUEUED) D
  1.  . K %ZIS,POP
  1.  . D ^%ZISC,HOME^%ZIS
  1.  Q