- 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 Mar 13, 2025@21:35:10 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
