PXRRGPRT ;ISL/PKR - PCE reports general printing routines. 4/17/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**3,12,20**;Aug 12, 1996
;
;=======================================================================
CLASSNE(INDENT) ;Print the selected Person Classes that had no encounters.
;PXRRPECL is the input list, the fourth piece is "M" if a match was
;found.
N CLS,IC,NOMATCH,TEMP
S NOMATCH=0
F IC=1:1:NCL Q:NOMATCH D
. I $P(PXRRPECL(IC),U,4)'="M" S NOMATCH=1
;
;Print the list.
I NOMATCH D
. W !!,?INDENT,"The following selected Person Classes had no encounters that met the"
. W !,?INDENT,"selection criteria:"
. S CLS=INDENT+INDENT
. F IC=1:1:NCL D
.. S TEMP=PXRRPECL(IC)
.. I $P(TEMP,U,4)'="M" D
... W !!,?CLS,"Occupation: ",$P(TEMP,U,1)
... W !,?CLS,"Specialty: ",$P(TEMP,U,2)
... W !,?CLS,"Subspecialty: ",$P(TEMP,U,3)
Q
;
;=======================================================================
FACNE(INDENT) ;Print the selected facilities that had no encounters.
;PXRRFAC is the input list, the fourth piece is "M" if a match was
;found.
N IC,IND,NOMATCH,TEMP
S NOMATCH=0
F IC=1:1:NFAC Q:NOMATCH D
. I $P(PXRRFAC(IC),U,4)'="M" S NOMATCH=1
;
;Print the list.
I NOMATCH D
. W !!,"The following selected Facilities had no encounters that met the selection"
. W !,"criteria:"
. F IC=1:1:NFAC D
.. I $P(PXRRFAC(IC),U,4)'="M" D
... S IND=$P(PXRRFAC(IC),U,1)
... S TEMP=PXRRFACN(IND)
... W !,?INDENT,$P(TEMP,U,1)," ",$P(TEMP,U,2)
Q
;
;=======================================================================
HDR(PAGE) ;
I $E(IOST)="C",IO=IO(0) W @IOF
E W !
N TEMP,TEXTLEN
S TEMP=$$NOW^XLFDT,TEMP=$$FMTE^XLFDT(TEMP,"P")
S TEMP=TEMP_" Page "_PAGE
S TEXTLEN=$L(TEMP)
W ?(IOM-TEXTLEN),TEMP
;PXRROPT should be newed in the main driver.
I '$D(PXRROPT) D
. S PXRROPT=$$TITLE
. I ($L(PXRROPT)>0)&(PXRROPT'["PCE") S PXRROPT="PCE "_PXRROPT
S TEXTLEN=$L(PXRROPT)
I TEXTLEN>0 D
. W !!
. W ?((IOM-TEXTLEN)/2),PXRROPT
Q
;
;=======================================================================
OLRCRIT(PSTART) ;Output the location report criteria.
N ED,SD
W !?PSTART,"Location selection criteria:",?32,$P(PXRRLCSC,U,2)
S SD=$$FMTE^XLFDT(PXRRBDT)
S ED=$$FMTE^XLFDT(PXRREDT)
W !?PSTART,"Encounter date range:",?32,SD," through ",ED
I $D(PXRRSCAT) D OSCAT(PXRRSCAT,PSTART)
I $D(PXRRENTY) D OENTYPE(PXRRENTY,PSTART)
W !,"___________________________________________________________________"
Q
;
;=======================================================================
OENTYPE(ENTYL,PSTART) ;Output the encounter types used for screening the encounters.
N IC,CSTART,EM,ENTYPE,ENTTEXT
S CSTART=PSTART+3
W !,?PSTART,"Encounter types:",?32,ENTYL
F IC=1:1:$L(ENTYL) D
. S ENTYPE=$E(ENTYL,IC,IC)
. S ENTTEXT=$$EXTERNAL^DILFD(9000010,15003,"",ENTYPE,.EM)
. W !,?CSTART,ENTYPE," - ",ENTTEXT
Q
;
;=======================================================================
OPRCRIT(PSTART) ;Output the provider report criteria.
N ED,SD
W !?PSTART,"Provider selection criteria:",?32,$P(PXRRPRSC,U,2)
S SD=$$FMTE^XLFDT(PXRRBDT)
S ED=$$FMTE^XLFDT(PXRREDT)
W !?PSTART,"Report date range:",?32,SD," through ",ED
D OSCAT(PXRRSCAT,PSTART)
I $P($G(PXRRPRSC),U,1)="C" D PECLASS^PXRRGPRT(PSTART)
I $D(PXRRENTY) D OENTYPE(PXRRENTY,PSTART)
W !,"___________________________________________________________________"
Q
;
;=======================================================================
OSCAT(SCL,PSTART) ;Output the service categeories used for screening the encounters.
N IC,CSTART,EM,SC,SCTEXT
S CSTART=PSTART+3
W !,?PSTART,"Service categories:",?32,SCL
F IC=1:1:$L(SCL) D
. S SC=$E(SCL,IC,IC)
. S SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
. W !,?CSTART,SC," - ",SCTEXT
Q
;
;=======================================================================
PAGE ;form feed to new page
I ($E(IOST)="C")&(IO=IO(0)) D
. S DIR(0)="E"
. W !
. D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT)) S DONE=1 Q
W:$D(IOF) @IOF
S PAGE=PAGE+1
D HDR^PXRRGPRT(PAGE)
S HEAD=1
Q
;
;=======================================================================
PECLASS(CLS) ;Print the list of selected Person Classes.
N IC,TEMP
S TEMP=$P(PXRRPRSC,U,2)_": "
W !!,TEMP
F IC=1:1:NCL D
. S TEMP=PXRRPECL(IC)
. I IC>1 W !
. W !,?CLS,"Occupation: ",$P(TEMP,U,1)
. W !,?CLS,"Specialty: ",$P(TEMP,U,2)
. W !,?CLS,"Subspecialty: ",$P(TEMP,U,3)
Q
;
;=======================================================================
PTOTAL(TEXT,TOTAL,END,LINE) ;Print totals.
N IC,TEXLEN,TOTLEN
S TEXLEN=$L(TEXT)
S TOTLEN=$L(TOTAL)
I LINE D
. W !,?(END-TOTLEN-1) F IC=1:1:TOTLEN+2 W "_"
W !,?(END-TEXLEN-TOTLEN),TEXT,?(END-TOTLEN),TOTAL,!
Q
;
;=======================================================================
TITLE() ;Set title from option file name.
N XQOPT
I +$G(XQY)>0 D OP^XQCHK
Q $P($G(XQOPT),U,2)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRGPRT 5011 printed Dec 13, 2024@02:30:43 Page 2
PXRRGPRT ;ISL/PKR - PCE reports general printing routines. 4/17/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,12,20**;Aug 12, 1996
+2 ;
+3 ;=======================================================================
CLASSNE(INDENT) ;Print the selected Person Classes that had no encounters.
+1 ;PXRRPECL is the input list, the fourth piece is "M" if a match was
+2 ;found.
+3 NEW CLS,IC,NOMATCH,TEMP
+4 SET NOMATCH=0
+5 FOR IC=1:1:NCL
if NOMATCH
QUIT
Begin DoDot:1
+6 IF $PIECE(PXRRPECL(IC),U,4)'="M"
SET NOMATCH=1
End DoDot:1
+7 ;
+8 ;Print the list.
+9 IF NOMATCH
Begin DoDot:1
+10 WRITE !!,?INDENT,"The following selected Person Classes had no encounters that met the"
+11 WRITE !,?INDENT,"selection criteria:"
+12 SET CLS=INDENT+INDENT
+13 FOR IC=1:1:NCL
Begin DoDot:2
+14 SET TEMP=PXRRPECL(IC)
+15 IF $PIECE(TEMP,U,4)'="M"
Begin DoDot:3
+16 WRITE !!,?CLS,"Occupation: ",$PIECE(TEMP,U,1)
+17 WRITE !,?CLS,"Specialty: ",$PIECE(TEMP,U,2)
+18 WRITE !,?CLS,"Subspecialty: ",$PIECE(TEMP,U,3)
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;=======================================================================
FACNE(INDENT) ;Print the selected facilities that had no encounters.
+1 ;PXRRFAC is the input list, the fourth piece is "M" if a match was
+2 ;found.
+3 NEW IC,IND,NOMATCH,TEMP
+4 SET NOMATCH=0
+5 FOR IC=1:1:NFAC
if NOMATCH
QUIT
Begin DoDot:1
+6 IF $PIECE(PXRRFAC(IC),U,4)'="M"
SET NOMATCH=1
End DoDot:1
+7 ;
+8 ;Print the list.
+9 IF NOMATCH
Begin DoDot:1
+10 WRITE !!,"The following selected Facilities had no encounters that met the selection"
+11 WRITE !,"criteria:"
+12 FOR IC=1:1:NFAC
Begin DoDot:2
+13 IF $PIECE(PXRRFAC(IC),U,4)'="M"
Begin DoDot:3
+14 SET IND=$PIECE(PXRRFAC(IC),U,1)
+15 SET TEMP=PXRRFACN(IND)
+16 WRITE !,?INDENT,$PIECE(TEMP,U,1)," ",$PIECE(TEMP,U,2)
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
+19 ;=======================================================================
HDR(PAGE) ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE @IOF
+2 IF '$TEST
WRITE !
+3 NEW TEMP,TEXTLEN
+4 SET TEMP=$$NOW^XLFDT
SET TEMP=$$FMTE^XLFDT(TEMP,"P")
+5 SET TEMP=TEMP_" Page "_PAGE
+6 SET TEXTLEN=$LENGTH(TEMP)
+7 WRITE ?(IOM-TEXTLEN),TEMP
+8 ;PXRROPT should be newed in the main driver.
+9 IF '$DATA(PXRROPT)
Begin DoDot:1
+10 SET PXRROPT=$$TITLE
+11 IF ($LENGTH(PXRROPT)>0)&(PXRROPT'["PCE")
SET PXRROPT="PCE "_PXRROPT
End DoDot:1
+12 SET TEXTLEN=$LENGTH(PXRROPT)
+13 IF TEXTLEN>0
Begin DoDot:1
+14 WRITE !!
+15 WRITE ?((IOM-TEXTLEN)/2),PXRROPT
End DoDot:1
+16 QUIT
+17 ;
+18 ;=======================================================================
OLRCRIT(PSTART) ;Output the location report criteria.
+1 NEW ED,SD
+2 WRITE !?PSTART,"Location selection criteria:",?32,$PIECE(PXRRLCSC,U,2)
+3 SET SD=$$FMTE^XLFDT(PXRRBDT)
+4 SET ED=$$FMTE^XLFDT(PXRREDT)
+5 WRITE !?PSTART,"Encounter date range:",?32,SD," through ",ED
+6 IF $DATA(PXRRSCAT)
DO OSCAT(PXRRSCAT,PSTART)
+7 IF $DATA(PXRRENTY)
DO OENTYPE(PXRRENTY,PSTART)
+8 WRITE !,"___________________________________________________________________"
+9 QUIT
+10 ;
+11 ;=======================================================================
OENTYPE(ENTYL,PSTART) ;Output the encounter types used for screening the encounters.
+1 NEW IC,CSTART,EM,ENTYPE,ENTTEXT
+2 SET CSTART=PSTART+3
+3 WRITE !,?PSTART,"Encounter types:",?32,ENTYL
+4 FOR IC=1:1:$LENGTH(ENTYL)
Begin DoDot:1
+5 SET ENTYPE=$EXTRACT(ENTYL,IC,IC)
+6 SET ENTTEXT=$$EXTERNAL^DILFD(9000010,15003,"",ENTYPE,.EM)
+7 WRITE !,?CSTART,ENTYPE," - ",ENTTEXT
End DoDot:1
+8 QUIT
+9 ;
+10 ;=======================================================================
OPRCRIT(PSTART) ;Output the provider report criteria.
+1 NEW ED,SD
+2 WRITE !?PSTART,"Provider selection criteria:",?32,$PIECE(PXRRPRSC,U,2)
+3 SET SD=$$FMTE^XLFDT(PXRRBDT)
+4 SET ED=$$FMTE^XLFDT(PXRREDT)
+5 WRITE !?PSTART,"Report date range:",?32,SD," through ",ED
+6 DO OSCAT(PXRRSCAT,PSTART)
+7 IF $PIECE($GET(PXRRPRSC),U,1)="C"
DO PECLASS^PXRRGPRT(PSTART)
+8 IF $DATA(PXRRENTY)
DO OENTYPE(PXRRENTY,PSTART)
+9 WRITE !,"___________________________________________________________________"
+10 QUIT
+11 ;
+12 ;=======================================================================
OSCAT(SCL,PSTART) ;Output the service categeories used for screening the encounters.
+1 NEW IC,CSTART,EM,SC,SCTEXT
+2 SET CSTART=PSTART+3
+3 WRITE !,?PSTART,"Service categories:",?32,SCL
+4 FOR IC=1:1:$LENGTH(SCL)
Begin DoDot:1
+5 SET SC=$EXTRACT(SCL,IC,IC)
+6 SET SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
+7 WRITE !,?CSTART,SC," - ",SCTEXT
End DoDot:1
+8 QUIT
+9 ;
+10 ;=======================================================================
PAGE ;form feed to new page
+1 IF ($EXTRACT(IOST)="C")&(IO=IO(0))
Begin DoDot:1
+2 SET DIR(0)="E"
+3 WRITE !
+4 DO ^DIR
KILL DIR
End DoDot:1
+5 IF $DATA(DUOUT)!($DATA(DTOUT))
SET DONE=1
QUIT
+6 if $DATA(IOF)
WRITE @IOF
+7 SET PAGE=PAGE+1
+8 DO HDR^PXRRGPRT(PAGE)
+9 SET HEAD=1
+10 QUIT
+11 ;
+12 ;=======================================================================
PECLASS(CLS) ;Print the list of selected Person Classes.
+1 NEW IC,TEMP
+2 SET TEMP=$PIECE(PXRRPRSC,U,2)_": "
+3 WRITE !!,TEMP
+4 FOR IC=1:1:NCL
Begin DoDot:1
+5 SET TEMP=PXRRPECL(IC)
+6 IF IC>1
WRITE !
+7 WRITE !,?CLS,"Occupation: ",$PIECE(TEMP,U,1)
+8 WRITE !,?CLS,"Specialty: ",$PIECE(TEMP,U,2)
+9 WRITE !,?CLS,"Subspecialty: ",$PIECE(TEMP,U,3)
End DoDot:1
+10 QUIT
+11 ;
+12 ;=======================================================================
PTOTAL(TEXT,TOTAL,END,LINE) ;Print totals.
+1 NEW IC,TEXLEN,TOTLEN
+2 SET TEXLEN=$LENGTH(TEXT)
+3 SET TOTLEN=$LENGTH(TOTAL)
+4 IF LINE
Begin DoDot:1
+5 WRITE !,?(END-TOTLEN-1)
FOR IC=1:1:TOTLEN+2
WRITE "_"
End DoDot:1
+6 WRITE !,?(END-TEXLEN-TOTLEN),TEXT,?(END-TOTLEN),TOTAL,!
+7 QUIT
+8 ;
+9 ;=======================================================================
TITLE() ;Set title from option file name.
+1 NEW XQOPT
+2 IF +$GET(XQY)>0
DO OP^XQCHK
+3 QUIT $PIECE($GET(XQOPT),U,2)
+4 ;
