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

SDECSTSR.m

Go to the documentation of this file. 
  1. SDECSTSR ; ALB/WTC - VISTA SCHEDULING GUI; 21 Aug 2019  7:10 AM ; 13 Nov 2019  9:28 AM
  1.  ;;5.3;Scheduling;**737**;;Build 13
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified
  1.  Q
  1.  ;
  1.  ;  Report and fix appointment-encounter-appointment status triples from, respectively, the patient file (#2), the encounter file (#409.68) and
  1.  ;  the appointment file (#409.84).
  1.  ;
  1.  ;  Distinguish encounter status from before and after installation of patch 722 - 9/11/2019
  1.  ;
  1.  ;  ICR
  1.  ;  ---
  1.  ;  7030 - #2 patient appointment data
  1.  ;
  1. DOWNLOAD    ;
  1.  ;
  1.  ;  Generate summary of appointment-encounter-appointment triples in comma-delimited format that can be uploaded to Excel.
  1.  ;
  1.  ;  NOTE:  This download is an analysis tool run by programmers.  It is not linked to an option.
  1.  ;
  1.  W !!,"Generate summary of patient appointment-encounter-appointment file status triples in comma delimited format",! ;
  1.  ;
  1.  N TYPE S TYPE="DOWNLOAD" G SUMMARY1 ;
  1.  ;
  1. SUMMARY ;
  1.  ;
  1.  ;  Generate summary of appointment-encounter-appointment triples in report format.
  1.  ;
  1.  ;  NOTE:  This report is an analysis tool run by programmers.  It is not linked to an option.
  1.  ;
  1.  W !!,"Generate summary of patient appointment-encounter-appointment file status triples in report format",! ;
  1.  ;
  1.  N TYPE S TYPE="REPORT" ;
  1.  ;
  1. SUMMARY1 ;
  1.  ;
  1.  N %DT,START,Y,NAME,DFN,DTTM,PTDATA,PTSTATUS,ENCOUNTER,ENCDATA,ENCSTATUS,APPTDATA,APPTSTATUS,FOUND,I ;
  1.  N PATCH,ENCDATE,LASTDATE ;
  1.  ;
  1.  ;  Determine date that patch 722 was installed.
  1.  ;
  1.  S PATCH=$$PATCH(722) ;
  1.  ;
  1.  ;  Do not look at encounters that are less than a week old.
  1.  ;
  1.  S LASTDATE=$P($$FMADD^XLFDT($$NOW^XLFDT(),-7),".",1) ;
  1.  ;
  1.  ;  Scan is in date order starting with the user indicated date.
  1.  ;
  1.  W !,"Select appointment starting date",! ;
  1.  S %DT="AX" D ^%DT Q:Y<0  S START=$P(Y,".",1) W ! ;
  1.  ;
  1.  K ^TMP($J) ;
  1.  ;
  1.  ;  Scan patient file in alphabetic order.  Process patients that have appointments after the selected start date.
  1.  ;
  1.  S NAME="" F I=1:1 S NAME=$O(^DPT("B",NAME)) Q:NAME=""  S DFN=0 F  S DFN=$O(^DPT("B",NAME,DFN)) Q:'DFN  W:I#1000=0 "." I $O(^DPT(DFN,"S",START))>0 D  ;  
  1.  . ;
  1.  . ;  Scan patient's appointments.
  1.  . ;
  1.  . S DTTM=START F  S DTTM=$O(^DPT(DFN,"S",DTTM)) Q:'DTTM  Q:DTTM>LASTDATE  S PTDATA=^(DTTM,0) D  ;  ICR #7030
  1.  .. ;
  1.  .. ;  Get status of appointment in patient file.
  1.  .. ;
  1.  .. S PTSTATUS=$S($P(PTDATA,U,2)'="":$$SETCODES(2.98,3,$P(PTDATA,U,2)),1:"null") ;  ICR #7030
  1.  .. ;
  1.  .. ;  Get encounter from patient's appointment record and the status of the encounter from file.
  1.  .. ;
  1.  .. S ENCOUNTER=$P(PTDATA,U,20),ENCSTATUS=$S(ENCOUNTER:$P($G(^SCE(ENCOUNTER,0)),U,12),1:""),ENCSTATUS=$S(ENCOUNTER="":"NONE",ENCSTATUS="":"null",1:$$GET1^DIQ(409.63,ENCSTATUS_",",.01)) ;
  1.  .. ;
  1.  .. ;  Flag encounter status as BEFORE or AFTER patch 722 installation.
  1.  .. ;
  1.  .. I ENCSTATUS'="NONE" S ENCDATE=$P($G(^SCE(ENCOUNTER,"USER")),U,4),ENCSTATUS=ENCSTATUS_"-"_$S(ENCDATE="":"NO DATE",ENCDATE<PATCH:"BEFORE",1:"AFTER") ;
  1.  .. ;
  1.  .. ;   Scan appointments in the appointment time for the date/time of the appointment in the patient file.
  1.  .. ;
  1.  .. S DA=0,FOUND=0 F  S DA=$O(^SDEC(409.84,"APTDT",DFN,DTTM,DA)) Q:'DA  S APPTDATA=$G(^SDEC(409.84,DA,0)) I APPTDATA'="" S FOUND=1 D  ;
  1.  ... ;
  1.  ... ;   Get status of appointments in appointment file.  Update count of triple.
  1.  ... ;
  1.  ... S APPTSTATUS=$S($P(APPTDATA,U,17)'="":$$SETCODES(409.84,.17,$P(APPTDATA,U,17)),1:"null") ;
  1.  ... S ^(APPTSTATUS)=$G(^TMP($J,PTSTATUS,ENCSTATUS,APPTSTATUS))+1 ;
  1.  .. ;
  1.  .. ;  If no matching appointments (FOUND=0), update count for "status" of NONE.
  1.  .. ;
  1.  .. I 'FOUND S ^("NONE")=$G(^TMP($J,PTSTATUS,ENCSTATUS,"NONE"))+1 ;
  1.  ;
  1.  ;  If download selected, output results in comma-delimited format
  1.  ;
  1.  I TYPE="DOWNLOAD" D  ;
  1.  . W !,$C(34),"PATIENT"_$C(34),",",$C(34),"ENCOUNTER",$C(34),",",$C(34),"APPOINTMENT",$C(34),",",$C(34)_"COUNT",$C(34),! ;
  1.  . S PTSTATUS="" F  S PTSTATUS=$O(^TMP($J,PTSTATUS)) Q:PTSTATUS=""  D  ;
  1.  .. S ENCSTATUS="" F  S ENCSTATUS=$O(^TMP($J,PTSTATUS,ENCSTATUS)) Q:ENCSTATUS=""  D  ;
  1.  ... S APPTSTATUS="" F  S APPTSTATUS=$O(^TMP($J,PTSTATUS,ENCSTATUS,APPTSTATUS)) Q:APPTSTATUS=""  W $C(34),PTSTATUS,$C(34),",",$C(34),ENCSTATUS,$C(34),",",$C(34),APPTSTATUS,$C(34),",",^(APPTSTATUS),! ;
  1.  . ;
  1.  ;
  1.  ;  If report selected, output formatted report.
  1.  ;
  1.  I TYPE="REPORT" D  ;
  1.  . W !!,"PATIENT",?22,"ENCOUNTER",?44,"APPOINTMENT",?66+8-5,"COUNT",! ;
  1.  . W "--------------------",?22,"--------------------",?44,"--------------------",?66,"--------",! ;
  1.  . S PTSTATUS="" F  S PTSTATUS=$O(^TMP($J,PTSTATUS)) Q:PTSTATUS=""  W PTSTATUS D  ;
  1.  .. S ENCSTATUS="" F  S ENCSTATUS=$O(^TMP($J,PTSTATUS,ENCSTATUS)) Q:ENCSTATUS=""  W ?22,ENCSTATUS D  W ! ;
  1.  ... S APPTSTATUS="" F  S APPTSTATUS=$O(^TMP($J,PTSTATUS,ENCSTATUS,APPTSTATUS)) Q:APPTSTATUS=""  W ?44,APPTSTATUS,?66,$J(^(APPTSTATUS),8),! ;
  1.  . ;
  1.  K ^TMP($J) ;
  1.  ;
  1.  Q  ;
  1.  ;
  1. SETCODES(FILE,FIELD,VALUE) ;
  1.  ;
  1.  ;  Return text associated with a set of codes field in a file or sub-file.
  1.  ;
  1.  ;  FILE  = File number [REQUIRED]
  1.  ;  FIELD = Field number [REQUIRED]
  1.  ;  VALUE = Set of codes internal value [REQUIRED]
  1.  ;
  1.  N DD,VALUES,RETURN,I ;
  1.  ;
  1.  S DD=^DD(FILE,FIELD,0),VALUES=$P(DD,U,3),RETURN="" ;
  1.  F I=1:1 Q:$P(VALUES,";",I,99)=""  I $P($P(VALUES,";",I),":",1)=VALUE S RETURN=$P($P(VALUES,";",I),":",2) Q  ;
  1.  Q RETURN ;
  1.  ;
  1. PATCH(NUMBER) ;
  1.  ;
  1.  ;  Determine if patch has been installed.  Return installation date from Install file (#9.7).
  1.  ;
  1.  N X,DA ;
  1.  S DA=$O(^XPD(9.7,"B","SD*5.3*"_NUMBER,99999),-1) I 'DA Q "" ;
  1.  S X=$P($G(^XPD(9.7,DA,0)),U,9) I X'=3 Q "" ;
  1.  Q $P($P($G(^XPD(9.7,DA,1)),U,3),".",1) ;
  1.  ;
  1. SHOWPAT(DFN,APPTDTTM) ;
  1.  ;
  1.  ;  Display patient data.
  1.  ;
  1.  ;  DFN       = Pointer to #2 [REQUIRED]
  1.  ;  APPTDTTM  = Appointment date/time [REQUIRED]
  1.  ;
  1.  N DATA ;
  1.  ;
  1.  W !?80-27/2,"*** PATIENT APPOINTMENT ***" ;
  1.  W !,"Patient: ",$$GET1^DIQ(2,DFN_",",.01),?40,"Appointment date/time: ",$$FMTE^XLFDT(APPTDTTM,2),! ;
  1.  ;
  1.  S DATA=$G(^DPT(DFN,"S",APPTDTTM,0)) ;  ICR #7030
  1.  W "Clinic: ",$$GET1^DIQ(44,$P(DATA,U,1)_",",.01),?40,"Status: ",$S($P(DATA,U,2)'="":$$SETCODES(2.98,3,$P(DATA,U,2)),1:"null"),! ;
  1.  W "Date appointment made: ",$$FMTE^XLFDT($P($P(DATA,U,19),".",1),2),?40,"By: ",$$GET1^DIQ(200,$P(DATA,U,18)_",",.01),! ;
  1.  Q  ;
  1.  ;
  1. SHOWENC(ENCOUNTER) ;
  1.  ;
  1.  ;  Display encounter data.
  1.  ;
  1.  ;  ENCOUNTER = Pointer to #409.68 [REQUIRED]
  1.  ;
  1.  N DATA,USER,COUNT,DA ;
  1.  ;
  1.  ;  DATA     = Encounter file record
  1.  ;  USER     = "USER" node from Encounter file
  1.  ;  COUNT    = Number of child encounters
  1.  ;
  1.  W !?80-17/2,"*** ENCOUNTER ***" ;
  1.  I 'ENCOUNTER W !,"Encounter date: NO ENCOUNTER",! Q  ;
  1.  ;
  1.  S DATA=$G(^SCE(ENCOUNTER,0)),USER=$G(^SCE(ENCOUNTER,"USER")) ;
  1.  W !,"Encounter date: ",$$FMTE^XLFDT($P(DATA,U,1),2),! ;
  1.  W "Clinic: ",$$GET1^DIQ(44,$P(DATA,U,4)_",",.01),?40,"Status: ",$S($P(DATA,U,12)'="":$$GET1^DIQ(409.63,$P(DATA,U,12)_",",.01),1:"null"),! ;
  1.  W "Date created: ",$$FMTE^XLFDT($P($P(USER,U,4),".",1),2),?40,"By: ",$$GET1^DIQ(200,$P(USER,U,3)_",",.01),! ;
  1.  ;
  1.  ;  Show if encounter is a parent or child encounter.
  1.  ;
  1.  S COUNT=0,DA=0 F  S DA=$O(^SCE("APAR",ENCOUNTER,DA)) Q:'DA  S COUNT=COUNT+1 ;
  1.  ;
  1.  W $S($P(DATA,U,6)'="":"Child encounter",1:"NOT a Child encounter") ;
  1.  W ?40,$S(COUNT:"Parent of "_COUNT_" encounters",1:"NOT a Parent encounter"),! ;
  1.  ;
  1.  ;  Show number of dependent entries.
  1.  ;
  1.  W "Number of dependent entries: ",$$DEPNDENT(ENCOUNTER),! ;
  1.  ;
  1.  Q  ;
  1.  ;
  1. DEPNDENT(ENCOUNTER) ;
  1.  ;
  1.  ;  Return number of dependent entries for an encounter
  1.  ;
  1.  N PXQRECI,X,Y,COUNT ;
  1.  ;
  1.  S PXQRECI=0,X=$$DEC^PXQFE(ENCOUNTER,1,""),Y=$O(^TMP("PXQRECORD",$J,PXQRECI,"")),COUNT=$P(Y,"COUNT= ",2) K ^TMP("PXQRECORD",$J) ;
  1.  Q COUNT ;
  1.  ;
  1. SHOWAPPT(APPTIEN) ;
  1.  ;
  1.  ;  Display appointment data.
  1.  ;
  1.  ;  APPTIEN   = Appointment (pointer to #409.84) [REQUIRED]
  1.  ;
  1.  N DATA ;
  1.  ;
  1.  W !?80-19/2,"*** APPOINTMENT ***" ;
  1.  I 'APPTIEN W !,"No appointment on file",! Q  ;
  1.  ;
  1.  S DATA=$G(^SDEC(409.84,APPTIEN,0)) ;
  1.  W !,"Resource: ",$$GET1^DIQ(409.831,$P(DATA,U,7)_",",.01),?40,"Status: ",$S($P(DATA,U,17)'="":$$SETCODES(409.84,.17,$P(DATA,U,17)),1:"null"),! ;
  1.  W "Date appointment made: ",$$FMTE^XLFDT($P(DATA,U,9),2),?40,"By: ",$$GET1^DIQ(200,$P(DATA,U,8)_",",.01),! ;
  1.  Q  ;
  1.  ;