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