- PXRRWLD ;ISL/PKR,ALB/Zoltan - Driver for PCE encounter summary report.;12/1/98
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
- MAIN ;
- N PXRRIOD,PXRRWLJB,PXRRWLST,PXRROPT,PXRRQUE,PXRRXTMP
- S PXRRXTMP=$$PXRRXTMP("PXRRWL")
- S ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Encounter Summary"
- ;
- ;Establish the selection criteria.
- FAC ;Get the facility list.
- N NFAC,PXRRFAC,PXRRFACN
- D FACILITY^PXRRLCSC
- I $D(DTOUT)!$D(DUOUT) G EXIT
- ;
- LORP ;See if the report is to be by location or provider.
- N PXRRWLSC
- D WHICH("L")
- I $D(DTOUT) G EXIT
- I $D(DUOUT) G FAC
- ;
- LOC ;Get the location(s) for the report.
- N NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
- I $P(PXRRWLSC,U,1)="L" D
- . S PXRRLCSC=""
- . D LOC^PXRRLCSC("Select ENCOUNTER LOCATION CRITERIA","HS")
- . I $P(PXRRLCSC,U,1)["C" D BYLOC^PXRRLCSC
- I $D(DTOUT) G EXIT
- I $D(DUOUT) G LORP
- ;
- PRV ;Get the provider(s) for the report.
- N NCL,NPL,PXRRPECL,PXRRPRLL,PXRRPRPL,PXRRPRSC
- N PXRRMPR
- S PXRRMPR=0
- I $P(PXRRWLSC,U,1)="P" D
- . D PRV^PXRRPRSC
- . I ('$D(DTOUT))&('$D(DUOUT)) D
- .. K DIRUT,DTOUT,DUOUT
- .. S DIR(0)="YA"
- .. S DIR("A",1)="Do you want providers broken out by location?"
- .. S DIR("A")="Enter Y (YES) or N (NO) "
- .. S DIR("B")="N"
- .. W !
- .. D ^DIR K DIR
- .. I $D(DIROUT) S DTOUT=1
- .. S PXRRPRLL=Y
- I $D(DTOUT) G EXIT
- I $D(DUOUT) G LORP
- ;
- DR ;Get the date range.
- N PXRRBDT,PXRREDT
- D PDR^PXRRADUT(.PXRRBDT,.PXRREDT,"ENCOUNTER")
- I $D(DTOUT) G EXIT
- I $D(DUOUT) G LORP
- ;
- SCAT ;Get the service categories.
- N PXRRSCAT
- D SCAT^PXRRECSC
- I $D(DTOUT) G EXIT
- I $D(DUOUT) G DR
- ;
- ENTY ;Get the encounter types.
- N PXRRENTY
- D ENTYPE^PXRRECSC
- I $D(DTOUT) G EXIT
- I $D(DUOUT) G SCAT
- ;
- ;Determine whether the report should be queued.
- S %ZIS="QM"
- W !
- D ^%ZIS
- I POP G EXIT
- S PXRRIOD=ION_";"_IOST_";"_IOM_";"_IOSL
- S PXRRQUE=$G(IO("Q"))
- ;
- I PXRRQUE D
- . ;Queue the report.
- . N DESC,IODEV,ROUTINE
- . S DESC="Encounter Summary Report - sort encounters"
- . S IODEV=""
- . S ROUTINE="SORT^PXRRWLSE"
- . S ^XTMP(PXRRXTMP,"SEZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
- .;
- . S DESC="Encounter Summary Report - sort appointments"
- . S IODEV=""
- . S ROUTINE="SORT^PXRRWLSA"
- . S ZTDTH="@"
- . S ^XTMP(PXRRXTMP,"SAZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
- .;
- . S DESC="Encounter Summary Report - print"
- . S IODEV=PXRRIOD
- . S ROUTINE="PXRRWLPR"
- . S ZTDTH="@"
- . S ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
- ;
- E D SORT^PXRRWLSE
- Q
- ;=======================================================================
- EXIT ;
- D EXIT^PXRRGUT
- Q
- ;
- ;=======================================================================
- SAVE ;Save the variables.
- S ZTSAVE("PXRRBDT")="",ZTSAVE("PXRREDT")=""
- S ZTSAVE("PXRRCS(")="",ZTSAVE("NCS")=""
- S ZTSAVE("PXRRENTY")=""
- S ZTSAVE("PXRRFAC(")="",ZTSAVE("NFAC")=""
- S ZTSAVE("PXRRFACN(")=""
- S ZTSAVE("PXRRIOD")=""
- S ZTSAVE("PXRRLCHL(")="",ZTSAVE("NHL")=""
- S ZTSAVE("PXRRLCSC")=""
- S ZTSAVE("PXRRPECL(")="",ZTSAVE("NCL")=""
- S ZTSAVE("PXRRPRLL")=""
- S ZTSAVE("PXRRPRPL(")="",ZTSAVE("NPL")=""
- S ZTSAVE("PXRRPRSC")=""
- S ZTSAVE("PXRRQUE")=""
- S ZTSAVE("PXRRSCAT")=""
- S ZTSAVE("PXRRXTMP")=""
- S ZTSAVE("PXRRWLSC")=""
- S ZTSAVE("PXRRMPR")=""
- Q
- ;
- ;=======================================================================
- WHICH(DEFAULT) ;Find out if the report is to be by location or provider.
- N X,Y
- K DIROUT,DIRUT,DTOUT,DUOUT
- S DIR(0)="S"_U_"L:Location;"
- S DIR(0)=DIR(0)_"P:Provider"
- S DIR("A")="Do the report by"
- S DIR("B")=DEFAULT
- W !!,"This report may be done by location or provider"
- D ^DIR K DIR
- I $D(DIROUT) S DTOUT=1
- I $D(DTOUT)!($D(DUOUT)) Q
- S PXRRWLSC=Y_U_Y(0)
- Q
- ;
- PXRRXTMP(PXPFX) ; Extrinsic variable.
- ; Gets a unique PXRRXTMP value.
- S PFPFX=$G(PXPFX,"PXRRXTMP") ; Unizue ^XTMP prefix.
- N PXRRXTMP ; Value to return.
- N PXDONE
- I '$D(^XTMP("PXRRXTMP")) D
- . N PXCREATE ; ^XTMP Creation date.
- . N PXPURGE ; ^XTMP Purge date.
- . L +^XTMP("PXRRXTMP",0):300
- . S PXCREATE=$$DT^XLFDT ; Today's date.
- . S PXPURGE=$$HTFM^XLFDT($H+365) ; Not more than one year from today.
- . S ^XTMP("PXRRXTMP",0)=PXCREATE_"^"_PXPURGE_"^PXRR XTMP Coordination"
- . L -^XTMP("PXRRXTMP",0)
- L +^XTMP("PXRRXTMP",1):300
- S PXDONE=0
- F D Q:PXDONE
- . S (^XTMP("PXRRXTMP",1),PXRRXTMP)=$G(^XTMP("PXRRXTMP",1),0)+1
- . S PXRRXTMP=PXPFX_PXRRXTMP
- . Q:$D(^XTMP(PXRRXTMP))
- . Q:$D(^TMP(PXRRXTMP))
- . Q:$D(^TMP($J,PXRRXTMP))
- . S PXDONE=1
- L -^XTMP("PXRRXTMP",1)
- Q PXRRXTMP
- PXRRWLD ;ISL/PKR,ALB/Zoltan - Driver for PCE encounter summary report.;12/1/98
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
- MAIN ;
- +1 NEW PXRRIOD,PXRRWLJB,PXRRWLST,PXRROPT,PXRRQUE,PXRRXTMP
- +2 SET PXRRXTMP=$$PXRRXTMP("PXRRWL")
- +3 SET ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Encounter Summary"
- +4 ;
- +5 ;Establish the selection criteria.
- FAC ;Get the facility list.
- +1 NEW NFAC,PXRRFAC,PXRRFACN
- +2 DO FACILITY^PXRRLCSC
- +3 IF $DATA(DTOUT)!$DATA(DUOUT)
- GOTO EXIT
- +4 ;
- LORP ;See if the report is to be by location or provider.
- +1 NEW PXRRWLSC
- +2 DO WHICH("L")
- +3 IF $DATA(DTOUT)
- GOTO EXIT
- +4 IF $DATA(DUOUT)
- GOTO FAC
- +5 ;
- LOC ;Get the location(s) for the report.
- +1 NEW NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
- +2 IF $PIECE(PXRRWLSC,U,1)="L"
- Begin DoDot:1
- +3 SET PXRRLCSC=""
- +4 DO LOC^PXRRLCSC("Select ENCOUNTER LOCATION CRITERIA","HS")
- +5 IF $PIECE(PXRRLCSC,U,1)["C"
- DO BYLOC^PXRRLCSC
- End DoDot:1
- +6 IF $DATA(DTOUT)
- GOTO EXIT
- +7 IF $DATA(DUOUT)
- GOTO LORP
- +8 ;
- PRV ;Get the provider(s) for the report.
- +1 NEW NCL,NPL,PXRRPECL,PXRRPRLL,PXRRPRPL,PXRRPRSC
- +2 NEW PXRRMPR
- +3 SET PXRRMPR=0
- +4 IF $PIECE(PXRRWLSC,U,1)="P"
- Begin DoDot:1
- +5 DO PRV^PXRRPRSC
- +6 IF ('$DATA(DTOUT))&('$DATA(DUOUT))
- Begin DoDot:2
- +7 KILL DIRUT,DTOUT,DUOUT
- +8 SET DIR(0)="YA"
- +9 SET DIR("A",1)="Do you want providers broken out by location?"
- +10 SET DIR("A")="Enter Y (YES) or N (NO) "
- +11 SET DIR("B")="N"
- +12 WRITE !
- +13 DO ^DIR
- KILL DIR
- +14 IF $DATA(DIROUT)
- SET DTOUT=1
- +15 SET PXRRPRLL=Y
- End DoDot:2
- End DoDot:1
- +16 IF $DATA(DTOUT)
- GOTO EXIT
- +17 IF $DATA(DUOUT)
- GOTO LORP
- +18 ;
- DR ;Get the date range.
- +1 NEW PXRRBDT,PXRREDT
- +2 DO PDR^PXRRADUT(.PXRRBDT,.PXRREDT,"ENCOUNTER")
- +3 IF $DATA(DTOUT)
- GOTO EXIT
- +4 IF $DATA(DUOUT)
- GOTO LORP
- +5 ;
- SCAT ;Get the service categories.
- +1 NEW PXRRSCAT
- +2 DO SCAT^PXRRECSC
- +3 IF $DATA(DTOUT)
- GOTO EXIT
- +4 IF $DATA(DUOUT)
- GOTO DR
- +5 ;
- ENTY ;Get the encounter types.
- +1 NEW PXRRENTY
- +2 DO ENTYPE^PXRRECSC
- +3 IF $DATA(DTOUT)
- GOTO EXIT
- +4 IF $DATA(DUOUT)
- GOTO SCAT
- +5 ;
- +6 ;Determine whether the report should be queued.
- +7 SET %ZIS="QM"
- +8 WRITE !
- +9 DO ^%ZIS
- +10 IF POP
- GOTO EXIT
- +11 SET PXRRIOD=ION_";"_IOST_";"_IOM_";"_IOSL
- +12 SET PXRRQUE=$GET(IO("Q"))
- +13 ;
- +14 IF PXRRQUE
- Begin DoDot:1
- +15 ;Queue the report.
- +16 NEW DESC,IODEV,ROUTINE
- +17 SET DESC="Encounter Summary Report - sort encounters"
- +18 SET IODEV=""
- +19 SET ROUTINE="SORT^PXRRWLSE"
- +20 SET ^XTMP(PXRRXTMP,"SEZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
- +21 ;
- +22 SET DESC="Encounter Summary Report - sort appointments"
- +23 SET IODEV=""
- +24 SET ROUTINE="SORT^PXRRWLSA"
- +25 SET ZTDTH="@"
- +26 SET ^XTMP(PXRRXTMP,"SAZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
- +27 ;
- +28 SET DESC="Encounter Summary Report - print"
- +29 SET IODEV=PXRRIOD
- +30 SET ROUTINE="PXRRWLPR"
- +31 SET ZTDTH="@"
- +32 SET ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
- End DoDot:1
- +33 ;
- +34 IF '$TEST
- DO SORT^PXRRWLSE
- +35 QUIT
- +36 ;=======================================================================
- EXIT ;
- +1 DO EXIT^PXRRGUT
- +2 QUIT
- +3 ;
- +4 ;=======================================================================
- SAVE ;Save the variables.
- +1 SET ZTSAVE("PXRRBDT")=""
- SET ZTSAVE("PXRREDT")=""
- +2 SET ZTSAVE("PXRRCS(")=""
- SET ZTSAVE("NCS")=""
- +3 SET ZTSAVE("PXRRENTY")=""
- +4 SET ZTSAVE("PXRRFAC(")=""
- SET ZTSAVE("NFAC")=""
- +5 SET ZTSAVE("PXRRFACN(")=""
- +6 SET ZTSAVE("PXRRIOD")=""
- +7 SET ZTSAVE("PXRRLCHL(")=""
- SET ZTSAVE("NHL")=""
- +8 SET ZTSAVE("PXRRLCSC")=""
- +9 SET ZTSAVE("PXRRPECL(")=""
- SET ZTSAVE("NCL")=""
- +10 SET ZTSAVE("PXRRPRLL")=""
- +11 SET ZTSAVE("PXRRPRPL(")=""
- SET ZTSAVE("NPL")=""
- +12 SET ZTSAVE("PXRRPRSC")=""
- +13 SET ZTSAVE("PXRRQUE")=""
- +14 SET ZTSAVE("PXRRSCAT")=""
- +15 SET ZTSAVE("PXRRXTMP")=""
- +16 SET ZTSAVE("PXRRWLSC")=""
- +17 SET ZTSAVE("PXRRMPR")=""
- +18 QUIT
- +19 ;
- +20 ;=======================================================================
- WHICH(DEFAULT) ;Find out if the report is to be by location or provider.
- +1 NEW X,Y
- +2 KILL DIROUT,DIRUT,DTOUT,DUOUT
- +3 SET DIR(0)="S"_U_"L:Location;"
- +4 SET DIR(0)=DIR(0)_"P:Provider"
- +5 SET DIR("A")="Do the report by"
- +6 SET DIR("B")=DEFAULT
- +7 WRITE !!,"This report may be done by location or provider"
- +8 DO ^DIR
- KILL DIR
- +9 IF $DATA(DIROUT)
- SET DTOUT=1
- +10 IF $DATA(DTOUT)!($DATA(DUOUT))
- QUIT
- +11 SET PXRRWLSC=Y_U_Y(0)
- +12 QUIT
- +13 ;
- PXRRXTMP(PXPFX) ; Extrinsic variable.
- +1 ; Gets a unique PXRRXTMP value.
- +2 ; Unizue ^XTMP prefix.
- SET PFPFX=$GET(PXPFX,"PXRRXTMP")
- +3 ; Value to return.
- NEW PXRRXTMP
- +4 NEW PXDONE
- +5 IF '$DATA(^XTMP("PXRRXTMP"))
- Begin DoDot:1
- +6 ; ^XTMP Creation date.
- NEW PXCREATE
- +7 ; ^XTMP Purge date.
- NEW PXPURGE
- +8 LOCK +^XTMP("PXRRXTMP",0):300
- +9 ; Today's date.
- SET PXCREATE=$$DT^XLFDT
- +10 ; Not more than one year from today.
- SET PXPURGE=$$HTFM^XLFDT($HOROLOG+365)
- +11 SET ^XTMP("PXRRXTMP",0)=PXCREATE_"^"_PXPURGE_"^PXRR XTMP Coordination"
- +12 LOCK -^XTMP("PXRRXTMP",0)
- End DoDot:1
- +13 LOCK +^XTMP("PXRRXTMP",1):300
- +14 SET PXDONE=0
- +15 FOR
- Begin DoDot:1
- +16 SET (^XTMP("PXRRXTMP",1),PXRRXTMP)=$GET(^XTMP("PXRRXTMP",1),0)+1
- +17 SET PXRRXTMP=PXPFX_PXRRXTMP
- +18 IF $DATA(^XTMP(PXRRXTMP))
- QUIT
- +19 IF $DATA(^TMP(PXRRXTMP))
- QUIT
- +20 IF $DATA(^TMP($JOB,PXRRXTMP))
- QUIT
- +21 SET PXDONE=1
- End DoDot:1
- IF PXDONE
- QUIT
- +22 LOCK -^XTMP("PXRRXTMP",1)
- +23 QUIT PXRRXTMP
