- 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 Jan 18, 2025@03:31: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 ;