Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCDXPOV

SCDXPOV.m

Go to the documentation of this file. 
  1. SCDXPOV ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ; 05 Oct 98  8:37 PM
  1.  ;;5.3;Scheduling;**73,118,123,159,173**;AUG 13, 1993
  1.  ;
  1.  Q
  1. EN ;  Main entry point for the visit report.
  1.  ;
  1.  ;  Variables:
  1.  ;     SCXBEG  - Beginning date for encounters
  1.  ;     SCXEND  - Ending date for encounters
  1.  ;     SCXMD   - Multi-divisional Flag, 1: Multi-divisional, 0: if not
  1.  ;     SCXSITE - Site
  1.  ;     SCXSN   - Site Number
  1.  ;     SCDIV    - Division
  1.  ;     SCHDIV   - Temporary division holder
  1.  ;     SCXTFLG - Flag for show totals only
  1.  ;     SCXOPT  - Report option, 1: transmission only, 2: visit only, 3: both
  1.  ;     SCXABRT - Flag abort condition
  1.  ;
  1.  N SCXBEG,SCXEND,SCXMD,SCDIV,SCHDIV,SCXTFLG,SCXOPT,SCXABRT
  1.  ;
  1.  K ^TMP("SCDXPOV",$J),^TMP("SCDXV",$J)
  1.  ;
  1.  S SCXBEG=$$GETDATE^SCDXPOV2("From Date: ")
  1.  G:SCXBEG<0 END
  1. EN1 S SCXEND=$$GETDATE^SCDXPOV2("To Date: ")
  1.  G:SCXEND<0 END
  1.  I SCXEND<SCXBEG D  G EN1
  1.  . W !!,"TO DATE CANNOT BE EARLIER THAN FROM DATE",!
  1.  S SCXEND=SCXEND+.9
  1.  S SCXMD=0 I $D(^DIC(4,+$$SITE^VASITE(SCXBEG),"DIV")),^("DIV")="Y" S SCXMD=1
  1.  S SCXOPT=$$RPTOPT^SCDXPOV2 G:SCXOPT<0 END
  1.  I SCXMD,SCXOPT'[2 S SCXTFLG=$$SHWTOT^SCDXPOV2 G:SCXTFLG<0 END
  1.  S %ZIS="Q" D ^%ZIS  G:POP END
  1.  I $D(IO("Q")) D QUE^SCDXPOV2 G END
  1.  ;
  1. START ;
  1.  S SCXABRT=0
  1.  S SCDIV=$P($$SITE^VASITE(SCXBEG),U,3)
  1.  I SCXMD F SCDIV=0:0 S SCDIV=$O(^DG(40.8,SCDIV)) Q:'SCDIV  S SCHDIV=SCDIV,SCDIV=$P($$SITE^VASITE(SCXBEG,+SCDIV),U,3) D:SCDIV]"" INIT(SCDIV) S SCDIV=SCHDIV
  1.  I 'SCXMD D INIT(SCDIV)
  1.  ;
  1.  D BUILD(SCXBEG,SCXEND)
  1.  D:SCXOPT'[2 WRT^SCDXPOV1
  1.  G:SCXABRT END
  1.  D:SCXOPT'=1 WRT^SCDXPOV3
  1.  ;
  1. END ;
  1.  D:'$D(ZTQUEUED) ^%ZISC
  1.  K ^TMP("SCDXPOV",$J),^TMP("SCDXV",$J),ZTDESCR,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
  1.  Q
  1.  ;
  1. BUILD(SCXB,SCXE) ; Order through the encounters in the selected date range and process.
  1.  ;    Input:
  1.  ;        SCXB  -  Beginnging date (SCXBEG)
  1.  ;        SCXE  -  Ending date (SCXEND)
  1.  ;
  1.  ;    Variables
  1.  ;        SDT   -  Date being checked
  1.  ;        SCXOE -  Outpatient encounter being checked
  1.  ; 
  1.  N SDT,SCXOE
  1.  ;
  1.  S SDT=SCXB-.1
  1.  F  S SDT=$O(^SCE("B",SDT)) Q:SDT'>0!(SDT>SCXE)  D
  1.  . S SCXOE=0
  1.  . F  S SCXOE=$O(^SCE("B",SDT,SCXOE)) Q:SCXOE'>0  D:$D(^SCE(SCXOE,0)) GOTIT(SCXOE)
  1.  Q
  1.  ;
  1. GOTIT(SCXOE) ;  Process line of data in the OUTPATIENT ENCOUNTER FILE
  1.  ;    Input:
  1.  ;        SCXOE  -  IEN of entry in the OUTPATIENT ENCOUNTER File, #409.73
  1.  ;    Variables
  1.  ;        SCX    - 0 node of the OUTPATIENT ENCOUNTER entry
  1.  ;        SCX1   - 0 node of the TRANSMITTED OUTPATIENT ENCOUNTER entry
  1.  ;        SCX2   - 1 node of the TRANSMITTED OUTPATIENT ENCOUNTER entry
  1.  ;        SCXI   - IEN of the associated entry (SCX) in the TRANSMITTED OUTPATIENT ENCOUNTER File
  1.  ;        SCXEL  - Eligibility of the encounter
  1.  ;        SCXCV  - Originating process for the encounter
  1.  ;        SCXCP  - 1 if appt. type is C&P, 0 if not
  1.  ;        SCXDV  - Division where the encounter took place
  1.  ;        SCXACK - Acknowledgement status of TRANSMITTED OUTPATIENT ENCOUNTER entry  
  1.  ;                 0 - No information
  1.  ;                 1 - Waiting Transmission 
  1.  ;                 2 - Transmitted
  1.  ;                 3 - Acknowledged
  1.  ;
  1.  N SCX,SCX1,SCX2,SCXI,SCXEL,SCXCV,SCXCP,SCXDV,SCXACK
  1.  ;
  1.  Q:'$D(^SD(409.73,"AENC",SCXOE))
  1.  S SCX=^SCE(SCXOE,0)
  1.  S SCXI=0,SCXI=$O(^SD(409.73,"AENC",SCXOE,SCXI))
  1.  S SCX1=^SD(409.73,SCXI,0),SCX2=$G(^(1))
  1.  ;
  1.  S SCXEL=$P(SCX,U,13)
  1.  Q:SCXEL']""  Q:'$D(^DIC(8,SCXEL,0))
  1.  S SCXCV=$P(SCX,U,8) Q:SCXCV=4  S SCXCV=$$SCH(SCXCV)
  1.  S SCXCP=$S($P(SCX,U,10)=1:1,1:0)
  1.  S SCXDV=$P($$SITE^VASITE(SCXBEG,$P(SCX,U,11)),U,3)
  1.  ;
  1.  ;if division was inactive as of report start date, but division
  1.  ;  was active as of the date of this encounter, be sure an array entry
  1.  ;  exists to be able to count it. 
  1.  I SCXDV']"" D  Q:SCXDV']""
  1.  .D ECDT^SCDXUTL2(SCXI) S X=$P(X," ",1,3) D ^%DT
  1.  .S SCXDV=$P($$SITE^VASITE(Y,$P(SCX,U,11)),U,3)
  1.  .I SCXDV]"" D
  1.  ..D:'$D(^TMP("SCDXPOV",$J,SCXDV)) INIT(SCXDV)
  1.  ;
  1.  S SCXACK=0
  1.  ;
  1.  I $P(SCX1,U,4)=1&($P(SCX2,U,1)']"")&($P(SCX2,U,4)']"") S SCXACK=1
  1.  I $P(SCX1,U,4)=0&($P(SCX2,U,1)]"")&($P(SCX2,U,4)']"") S SCXACK=2
  1.  I $P(SCX1,U,4)=0&($P(SCX2,U,1)]"")&($P(SCX2,U,4)]"") S SCXACK=3
  1.  ;
  1.  Q:SCXACK=0
  1.  ;
  1.  ;I '$D(^TMP("SCDXPOV",$J,SCXDV)) D INIT(SCXDV)
  1.  Q:'$D(^TMP("SCDXPOV",$J,SCXDV))
  1.  ;
  1.  I SCXEL]"",$P(^DIC(8,SCXEL,0),U,5)="N" D
  1.  . S $P(^TMP("SCDXPOV",$J,SCXDV,"NVELIG",SCXEL),U,SCXACK)=+$P($G(^TMP("SCDXPOV",$J,SCXDV,"NVELIG",SCXEL)),U,SCXACK)+1
  1.  . S $P(^TMP("SCDXPOV",$J,"TOT","NVELIG",SCXEL),U,SCXACK)=+$P($G(^TMP("SCDXPOV",$J,"TOT","NVELIG",SCXEL)),U,SCXACK)+1
  1.  ;
  1.  I SCXEL]"",$P(^DIC(8,SCXEL,0),U,5)="Y" D
  1.  . S $P(^TMP("SCDXPOV",$J,SCXDV,"VELIG",SCXEL),U,SCXACK)=+$P($G(^TMP("SCDXPOV",$J,SCXDV,"VELIG",SCXEL)),U,SCXACK)+1
  1.  . S $P(^TMP("SCDXPOV",$J,"TOT","VELIG",SCXEL),U,SCXACK)=+$P($G(^TMP("SCDXPOV",$J,"TOT","VELIG",SCXEL)),U,SCXACK)+1
  1.  ;
  1.  I SCXCV]"",$D(^TMP("SCDXPOV",$J,SCXDV,"COV",SCXCV)) D
  1.  . S $P(^TMP("SCDXPOV",$J,SCXDV,"COV",SCXCV),U,SCXACK)=+$P(^TMP("SCDXPOV",$J,SCXDV,"COV",SCXCV),U,SCXACK)+1
  1.  . S $P(^TMP("SCDXPOV",$J,"TOT","COV",SCXCV),U,SCXACK)=+$P(^TMP("SCDXPOV",$J,"TOT","COV",SCXCV),U,SCXACK)+1
  1.  ;
  1.  I SCXCP,$D(^TMP("SCDXPOV",$J,SCXDV,"CP")) D
  1.  . S $P(^TMP("SCDXPOV",$J,SCXDV,"CP"),U,SCXACK)=+$P(^TMP("SCDXPOV",$J,SCXDV,"CP"),U,SCXACK)+1
  1.  . S $P(^TMP("SCDXPOV",$J,"TOT","CP"),U,SCXACK)=+$P(^TMP("SCDXPOV",$J,"TOT","CP"),U,SCXACK)+1
  1.  ;
  1.  ;  Removed D:SCXACK, all encounters will now count towards visit
  1.  D VISIT^SCDXPOV3($P($P(SCX,U),"."),$P(SCX,U,2),SCXEL,$P(^DIC(8,SCXEL,0),U,5),SCXCV,SCXCP)
  1.  ;
  1.  Q
  1.  ;
  1. SCH(SCXCV) ;Determine scheduled/unscheduled status for appointment type encounters
  1.  ;Output: if SCXCV=2 or 3, SCXCV; if SCXCV=1, then 1 if appointment was pre-scheduled or 2 if appointment was a walk-in
  1.  Q:SCXCV'=1 SCXCV
  1.  N SCXAP S SCXAP=$G(^DPT(+$P(SCX,U,2),"S",+SCX,0))
  1.  Q:$P(SCXAP,U,20)'=SCXOE SCXCV
  1.  Q:$P(SCXAP,U,7)=4 2
  1.  Q 1
  1.  ;
  1. INIT(SDIV) ;  Build TMP globals for encounter status count
  1.  ;   Ignores any entry beginning with "DOM" or "ZZ"
  1.  ;
  1.  ;   Input:
  1.  ;       SDIV   -  Medical Center Division
  1.  ;
  1.  ;   Variables
  1.  ;       SCXELG  - IEN from ELIGIBILITY CODE File, File #8
  1.  ;       SCXN    - 0 node for ELIGIBILITY CODE IEN
  1.  ;
  1.  N SCXELG,SCXN,LL
  1.  S SCXELG=0
  1.  ;
  1.  F  S SCXELG=$O(^DIC(8,SCXELG)) Q:'SCXELG  D
  1.  . S SCXN=$G(^DIC(8,SCXELG,0))
  1.  . Q:$$CHKELG^SCDXPOV2(SCXELG)
  1.  . I $P($G(^DIC(8,SCXELG,0)),U,5)="N" D
  1.  .. S ^TMP("SCDXPOV",$J,SDIV,"NVELIG",SCXELG)="0^0^0"
  1.  .. S:'$D(^TMP("SCDXPOV",$J,"TOT","NVELIG",SCXELG)) ^TMP("SCDXPOV",$J,"TOT","NVELIG",SCXELG)="0^0^0"
  1.  . I $P($G(^DIC(8,SCXELG,0)),U,5)="Y" D
  1.  .. S ^TMP("SCDXPOV",$J,SDIV,"VELIG",SCXELG)="0^0^0"
  1.  .. S:'$D(^TMP("SCDXPOV",$J,"TOT","VELIG",SCXELG)) ^TMP("SCDXPOV",$J,"TOT","VELIG",SCXELG)="0^0^0"
  1.  ;
  1.  F LL=1:1:3 D
  1.  . S ^TMP("SCDXPOV",$J,SDIV,"COV",LL)="0^0^0"
  1.  . S:'$D(^TMP("SCDXPOV",$J,"TOT","COV",LL)) ^TMP("SCDXPOV",$J,"TOT","COV",LL)="0^0^0"
  1.  ;
  1.  S ^TMP("SCDXPOV",$J,SDIV,"CP")="0^0^0"
  1.  S:'$D(^TMP("SCDXPOV",$J,"TOT","CP")) ^TMP("SCDXPOV",$J,"TOT","CP")="0^0^0"
  1.  Q