GMPLRPTS ; SLC/MKB -- Problem List Mgt Reports ;1/26/95 10:00
;;2.0;Problem List;**2**;Aug 25, 1994
PAT ; List patients having data in Problem file #9000011
N DFN,IFN,CNT,ST S GMPRT=0
D WAIT^DICD
F DFN=0:0 S DFN=$O(^AUPNPROB("AC",DFN)) Q:DFN'>0 D
. S (CNT("A"),CNT("I"),IFN)=0
. F S IFN=$O(^AUPNPROB("AC",DFN,IFN)) Q:IFN'>0 I $P($G(^AUPNPROB(IFN,1)),U,2)'="H" S ST=$P(^(0),U,12),CNT(ST)=CNT(ST)+1
. I (CNT("A")>0)!(CNT("I")>0) S GMPRT=GMPRT+1,^TMP("GMPRT",$J,$P(^DPT(DFN,0),U))=" "_+CNT("A")_$E(" ",1,7-$L(CNT("A")))_+CNT("I") W "."
I GMPRT'>0 W $C(7),!!,"No patient data available.",! G PATQ
S GMPLHDR="PROBLEM LIST PATIENT LISTING",GMPLCNT=1
D DEVICE G:$D(GMPQUIT) PATQ
D PRT
PATQ D KILL
Q
;
PROB ; Search for/List patients with selected problem
N X,Y,GMPTERM,GMPTEXT,IFN,DFN,STATUS,ST,TXT,NAME
PROB1 D SEARCH^GMPLX(.X,.Y) G:Y'>0 PROBQ
S GMPTERM=Y,GMPTEXT=$$UP^XLFSTR(X) S:+GMPTERM'>1 GMPTERM="1^"_GMPTEXT
S STATUS=$$STATUS G:STATUS="^" PROBQ
D WAIT^DICD S GMPRT=0
F IFN=0:0 S IFN=$O(^AUPNPROB("C",+GMPTERM,IFN)) Q:IFN'>0 D
. Q:$P($G(^AUPNPROB(IFN,1)),U,2)="H"
. Q:STATUS'[$P($G(^AUPNPROB(IFN,0)),U,12)
. S NODE=$G(^AUPNPROB(IFN,0)),DFN=$P(NODE,U,2),NAME=$P(^DPT(DFN,0),U),ST=$S($P(NODE,U,12)="A":"active",1:"inactive"),TXT=$P(NODE,U,5)
. I GMPTERM'>1,GMPTEXT'=$$UP^XLFSTR($P(^AUTNPOV(+TXT,0),U)) Q
. I '$D(^TMP("GMPRT",$J,NAME)) S GMPRT=GMPRT+1,^TMP("GMPRT",$J,NAME)=ST Q
. Q:(" "_^TMP("GMPRT",$J,NAME))[(" "_ST) ; already included
. S:$E(ST)="a" ^TMP("GMPRT",$J,NAME)=ST_", "_^TMP("GMPRT",$J,NAME)
. S:$E(ST)="i" ^TMP("GMPRT",$J,NAME)=^TMP("GMPRT",$J,NAME)_", "_ST
I GMPRT'>0 W $C(7),!!,"No patient data available.",! D KILL G PROB1
S GMPLHDR="PATIENTS WITH '"_$$UP^XLFSTR($P(GMPTERM,U,2))_"'",GMPLCNT=0
D DEVICE I $D(GMPQUIT) D KILL G PROB1
D PRT D KILL G PROB1
PROBQ D KILL
Q
;
KILL ; Clean-up after ourselves
K GMPRT,GMPLHDR,GMPQUIT,X,Y,^TMP("GMPRT",$J)
Q
;
DEVICE ; Prompt for device to send report to -- Sets GMPQUIT to quit
S %ZIS="Q" D ^%ZIS I POP S GMPQUIT=1 G DQ
I $D(IO("Q")) D
. S ZTRTN="PRT^GMPLRPTS",ZTDESC=GMPLHDR
. S (ZTSAVE("GMPRT"),ZTSAVE("^TMP(""GMPRT"",$J,"),ZTSAVE("GMPLHDR"),ZTSAVE("GMPLCNT"))=""
. D ^%ZTLOAD,HOME^%ZIS S:$D(ZTSK) GMPQUIT=1
DQ K IO("Q"),POP,%ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTSK
Q
;
PRT ; Print patient listing from ^TMP("GMPRT",$J,)
U IO N NAME,PAGE S NAME="",PAGE=0 D HDR
F S NAME=$O(^TMP("GMPRT",$J,NAME)) Q:NAME="" D Q:$D(GMPQUIT)
. I $Y>(IOSL-4) D RETURN Q:$D(GMPQUIT) D HDR
. W !,NAME,?60,^TMP("GMPRT",$J,NAME)
W:'$D(GMPQUIT) !!?10,"Total of "_GMPRT_" patients found."
W:IOST?1"P".E @IOF I IOST'?1"P".E,'$D(GMPQUIT) D RETURN
I $D(ZTQUEUED) S ZTREQ="@" D KILL
D ^%ZISC
Q
;
HDR ; Prints report header
W @IOF S PAGE=PAGE+1
W GMPLHDR,?60,$$EXTDT^GMPLX(DT),?70,"PAGE "_PAGE,!!
W "Patient Name",?60,$S(GMPLCNT:"# Active/Inactive",1:"Status"),!
W $$REPEAT^XLFSTR("-",79),!
Q
;
RETURN ; Checks for end-of-page, continue
Q:IOST?1"P".E N X,Y,DIR,I
F I=1:1:(IOSL-$Y-2) W !
S DIR(0)="E" D ^DIR S:'Y GMPQUIT=1
Q
;
STATUS() ; Prompts for problem status to search for
N DIR,X,Y
S DIR(0)="SA^A:ACTIVE;I:INACTIVE;B:BOTH;"
S DIR("A")="Select STATUS: ",DIR("B")="ACTIVE"
S DIR("?",1)="To list only those patients with this problem in a specific status, select:",DIR("?",2)=" ACTIVE",DIR("?",3)=" INACTIVE",DIR("?")=" BOTH ACTIVE & INACTIVE"
D ^DIR S:$D(DTOUT)!($D(DUOUT)) Y="^" S:Y="B" Y="AI"
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLRPTS 3514 printed Sep 23, 2025@20:06:32 Page 2
GMPLRPTS ; SLC/MKB -- Problem List Mgt Reports ;1/26/95 10:00
+1 ;;2.0;Problem List;**2**;Aug 25, 1994
PAT ; List patients having data in Problem file #9000011
+1 NEW DFN,IFN,CNT,ST
SET GMPRT=0
+2 DO WAIT^DICD
+3 FOR DFN=0:0
SET DFN=$ORDER(^AUPNPROB("AC",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+4 SET (CNT("A"),CNT("I"),IFN)=0
+5 FOR
SET IFN=$ORDER(^AUPNPROB("AC",DFN,IFN))
if IFN'>0
QUIT
IF $PIECE($GET(^AUPNPROB(IFN,1)),U,2)'="H"
SET ST=$PIECE(^(0),U,12)
SET CNT(ST)=CNT(ST)+1
+6 IF (CNT("A")>0)!(CNT("I")>0)
SET GMPRT=GMPRT+1
SET ^TMP("GMPRT",$JOB,$PIECE(^DPT(DFN,0),U))=" "_+CNT("A")_$EXTRACT(" ",1,7-$LENGTH(CNT("A")))_+CNT("I")
WRITE "."
End DoDot:1
+7 IF GMPRT'>0
WRITE $CHAR(7),!!,"No patient data available.",!
GOTO PATQ
+8 SET GMPLHDR="PROBLEM LIST PATIENT LISTING"
SET GMPLCNT=1
+9 DO DEVICE
if $DATA(GMPQUIT)
GOTO PATQ
+10 DO PRT
PATQ DO KILL
+1 QUIT
+2 ;
PROB ; Search for/List patients with selected problem
+1 NEW X,Y,GMPTERM,GMPTEXT,IFN,DFN,STATUS,ST,TXT,NAME
PROB1 DO SEARCH^GMPLX(.X,.Y)
if Y'>0
GOTO PROBQ
+1 SET GMPTERM=Y
SET GMPTEXT=$$UP^XLFSTR(X)
if +GMPTERM'>1
SET GMPTERM="1^"_GMPTEXT
+2 SET STATUS=$$STATUS
if STATUS="^"
GOTO PROBQ
+3 DO WAIT^DICD
SET GMPRT=0
+4 FOR IFN=0:0
SET IFN=$ORDER(^AUPNPROB("C",+GMPTERM,IFN))
if IFN'>0
QUIT
Begin DoDot:1
+5 if $PIECE($GET(^AUPNPROB(IFN,1)),U,2)="H"
QUIT
+6 if STATUS'[$PIECE($GET(^AUPNPROB(IFN,0)),U,12)
QUIT
+7 SET NODE=$GET(^AUPNPROB(IFN,0))
SET DFN=$PIECE(NODE,U,2)
SET NAME=$PIECE(^DPT(DFN,0),U)
SET ST=$SELECT($PIECE(NODE,U,12)="A":"active",1:"inactive")
SET TXT=$PIECE(NODE,U,5)
+8 IF GMPTERM'>1
IF GMPTEXT'=$$UP^XLFSTR($PIECE(^AUTNPOV(+TXT,0),U))
QUIT
+9 IF '$DATA(^TMP("GMPRT",$JOB,NAME))
SET GMPRT=GMPRT+1
SET ^TMP("GMPRT",$JOB,NAME)=ST
QUIT
+10 ; already included
if (" "_^TMP("GMPRT",$JOB,NAME))[(" "_ST)
QUIT
+11 if $EXTRACT(ST)="a"
SET ^TMP("GMPRT",$JOB,NAME)=ST_", "_^TMP("GMPRT",$JOB,NAME)
+12 if $EXTRACT(ST)="i"
SET ^TMP("GMPRT",$JOB,NAME)=^TMP("GMPRT",$JOB,NAME)_", "_ST
End DoDot:1
+13 IF GMPRT'>0
WRITE $CHAR(7),!!,"No patient data available.",!
DO KILL
GOTO PROB1
+14 SET GMPLHDR="PATIENTS WITH '"_$$UP^XLFSTR($PIECE(GMPTERM,U,2))_"'"
SET GMPLCNT=0
+15 DO DEVICE
IF $DATA(GMPQUIT)
DO KILL
GOTO PROB1
+16 DO PRT
DO KILL
GOTO PROB1
PROBQ DO KILL
+1 QUIT
+2 ;
KILL ; Clean-up after ourselves
+1 KILL GMPRT,GMPLHDR,GMPQUIT,X,Y,^TMP("GMPRT",$JOB)
+2 QUIT
+3 ;
DEVICE ; Prompt for device to send report to -- Sets GMPQUIT to quit
+1 SET %ZIS="Q"
DO ^%ZIS
IF POP
SET GMPQUIT=1
GOTO DQ
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTRTN="PRT^GMPLRPTS"
SET ZTDESC=GMPLHDR
+4 SET (ZTSAVE("GMPRT"),ZTSAVE("^TMP(""GMPRT"",$J,"),ZTSAVE("GMPLHDR"),ZTSAVE("GMPLCNT"))=""
+5 DO ^%ZTLOAD
DO HOME^%ZIS
if $DATA(ZTSK)
SET GMPQUIT=1
End DoDot:1
DQ KILL IO("Q"),POP,%ZIS,ZTRTN,ZTDESC,ZTSAVE,ZTSK
+1 QUIT
+2 ;
PRT ; Print patient listing from ^TMP("GMPRT",$J,)
+1 USE IO
NEW NAME,PAGE
SET NAME=""
SET PAGE=0
DO HDR
+2 FOR
SET NAME=$ORDER(^TMP("GMPRT",$JOB,NAME))
if NAME=""
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-4)
DO RETURN
if $DATA(GMPQUIT)
QUIT
DO HDR
+4 WRITE !,NAME,?60,^TMP("GMPRT",$JOB,NAME)
End DoDot:1
if $DATA(GMPQUIT)
QUIT
+5 if '$DATA(GMPQUIT)
WRITE !!?10,"Total of "_GMPRT_" patients found."
+6 if IOST?1"P".E
WRITE @IOF
IF IOST'?1"P".E
IF '$DATA(GMPQUIT)
DO RETURN
+7 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO KILL
+8 DO ^%ZISC
+9 QUIT
+10 ;
HDR ; Prints report header
+1 WRITE @IOF
SET PAGE=PAGE+1
+2 WRITE GMPLHDR,?60,$$EXTDT^GMPLX(DT),?70,"PAGE "_PAGE,!!
+3 WRITE "Patient Name",?60,$SELECT(GMPLCNT:"# Active/Inactive",1:"Status"),!
+4 WRITE $$REPEAT^XLFSTR("-",79),!
+5 QUIT
+6 ;
RETURN ; Checks for end-of-page, continue
+1 if IOST?1"P".E
QUIT
NEW X,Y,DIR,I
+2 FOR I=1:1:(IOSL-$Y-2)
WRITE !
+3 SET DIR(0)="E"
DO ^DIR
if 'Y
SET GMPQUIT=1
+4 QUIT
+5 ;
STATUS() ; Prompts for problem status to search for
+1 NEW DIR,X,Y
+2 SET DIR(0)="SA^A:ACTIVE;I:INACTIVE;B:BOTH;"
+3 SET DIR("A")="Select STATUS: "
SET DIR("B")="ACTIVE"
+4 SET DIR("?",1)="To list only those patients with this problem in a specific status, select:"
SET DIR("?",2)=" ACTIVE"
SET DIR("?",3)=" INACTIVE"
SET DIR("?")=" BOTH ACTIVE & INACTIVE"
+5 DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET Y="^"
if Y="B"
SET Y="AI"
+6 QUIT Y
