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

SCRPEC.m

Go to the documentation of this file. 
  1. SCRPEC ;ALB/CMM - Detail List of Pts & Enroll Clinics ; 29 Jun 99  04:11PM
  1.  ;;5.3;Scheduling;**41,140,174,177,431,526,520,1015**;AUG 13, 1993;Build 21
  1.  ;IHS/ANMC/LJF 10/26/2000 changed 132 column message
  1.  ;                        added call to list template
  1.  ;                        changed patient ID to HRCN
  1.  ;             11/01/2000 used IHS code for get next/last appts
  1.  ;                        used all clinics within a team
  1.  ;
  1.  ;Detailed Listing of Patients and Their Enrolled Clinics Report
  1.  ;
  1. PROMPTS ;
  1.  ;Prompt for Institution, Team, Clinic, Assigned or Unassigned to Primary
  1.  ;Care, and Print device
  1.  ;
  1.  N VAUTD,VAUTT,VAUTC,VAUTA,QTIME,PRNT
  1.  K VAUTD,VAUTT,VAUTC,VAUTA,VAUTCA,SCUP
  1.  S QTIME=""
  1.  W ! D INST^SCRPU1 I Y=-1 G ERR
  1.  W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR
  1.  ;S VAUTCA="" ;allows for selection of any clinic in one of the selected divisions
  1.  ;W ! K Y D CLINIC^SCRPU1 I '$D(VAUTC) G ERR  ;IHS/ANMC/LJF 11/1/2000
  1.  S VAUTC=1  ;IHS/ANMC/LJF 11/1/2000 use all clinics within team
  1.  W ! K Y D ASSUN^SCRPU2 I '$D(VAUTA) G ERR
  1.  ;W !!,"This report requires 132 column output!"  ;IHS/ANMC/LJF 10/26/2000
  1.  W !!,"This report, when printed on paper, requires wide paper or condensed print!"  ;IHS/ANMC/LJF 10/26/2000
  1.  D QUE(.VAUTD,.VAUTT,.VAUTC,.VAUTA) Q
  1.  ;
  1. QUE(INST,TEAM,CLINIC,ASSUN) ;queue report
  1.  ;Input Parameters: 
  1.  ;INST - institutions selected (variable and array) 
  1.  ;TEAM - teams selected (variable and array) 
  1.  ;CLINIC - clinics selected (variable and array) 
  1.  ;ASSUN - Assigned or Unassigned to PC
  1.  N ZTSAVE,II
  1.  F II="INST","TEAM","CLINIC","ASSUN","INST(","TEAM(","CLINIC(" S ZTSAVE(II)=""
  1.  W ! D EN^XUTMDEVQ("QENTRY^SCRPEC","Detailed Patient Enrollments",.ZTSAVE)
  1.  Q
  1.  ;
  1. ENTRY2(INST,TEAM,CLINIC,ASSUN,IOP,ZTDTH) ;
  1.  ;Second entry point for GUI to use
  1.  ;Input Parameters:
  1.  ;INST - institutions selected (variable and array)
  1.  ;TEAM - teams selected (variable and array)
  1.  ;CLINIC - clinics selected (variable and array)
  1.  ;ASSUN - Assigned or Unassigned to PC
  1.  ;IOP - print device
  1.  ;ZTDTH - queue time (optional)
  1.  ;
  1.  ;validate parameters
  1.  I '$D(INST)!'$D(TEAM)!'$D(CLINIC)!'$D(ASSUN)!'$D(IOP)!(IOP="") Q
  1.  ;
  1.  N NUMBER
  1.  S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
  1.  I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
  1.  I IOST?1"C-".E D QENTRY G RET
  1.  I ZTDTH="" S ZTDTH=$H
  1.  S ZTRTN="QENTRY^SCRPEC"
  1.  S ZTDESC="Detailed Patient List & Enrolled Clinics",ZTIO=IOP
  1.  N II
  1.  F II="INST","TEAM","CLINIC","ASSUN","INST(","TEAM(","CLINIC(","IOP" S ZTSAVE(II)=""
  1.  D ^%ZTLOAD
  1. RET S NUMBER=0
  1.  I $D(ZTSK) S NUMBER=ZTSK
  1.  D EXIT1
  1.  Q NUMBER
  1.  ;
  1. QENTRY ;
  1.  ;driver entry point
  1.  I $E(IOST,1,2)="C-" D EN^BSDSCEC Q  ;IHS/ANMC/LJF 10/26/2000
  1. IHS ;EP; entry point for list template  ;IHS/ANMC/LJF 10/26/2000
  1.  S VAUTTN=""
  1.  S TITL="Detailed Patient Assignments - "_$S(ASSUN=1:"Assigned PC",1:"Not Assigned PC")
  1.  S STORE="^TMP("_$J_",""SCRPEC"")"
  1.  K @STORE
  1.  S @STORE=0
  1.  D FIND^SCRPEC3
  1.  I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
  1.  I '$D(NODATA) D HEADER^SCRPEC2,PRINTIT^SCRPEC3(STORE,TITL)
  1.  D EXIT2
  1.  Q
  1.  ;
  1. ERR ;
  1. EXIT1 ;
  1.  K ZTSAVE,ZTSK,ZTIO,ZTDTH,ZTRTN,ZTDESC,VAUTCA,SCUP
  1.  Q
  1. EXIT2 ;
  1.  K @STORE
  1.  K STORE,VAUTTN,PAGE,TITL,IOP,TITL,NODATA,CLINIC,ASSUN,INST,TEAM,STOP
  1.  Q
  1.  ;
  1. PDATA(DFN,CLNEN,CNAME,FLAG) ;
  1.  ;Collect and format data for report
  1.  ;
  1.  N NODE,NAME,PID,PELIG,MT,PSTAT,STATD,DATA,LAST,NEXT
  1.  S DATA=""
  1.  S NODE=$G(^DPT(DFN,0))
  1.  S NAME=$P(NODE,"^") ;patient name
  1.  S PID=$P($G(^DPT(DFN,.36)),"^",3),PID=$TR(PID,"-","") ;PID without '-'s
  1.  S PID=$$HRCN^BDGF2(DFN,+$G(DUZ(2)))  ;IHS/ANMC/LJF 10/26/2000
  1.  S MT=$$LST^DGMTU(DFN),MT=$P(MT,"^",4)  ;means test status SD*5.3*431
  1.  S PELIG=$$ELIG^SCRPU3(DFN) ;primary eligibility
  1.  S PSTAT="N/A"
  1.  S STATD=""
  1.  ;S LAST=$$GETLAST^SCRPU3(DFN,CLNEN) ;last clinic appointment
  1.  ;S NEXT=$$GETNEXT^SCRPU3(DFN,CLNEN) ;next clinic appointment
  1.  S LAST=$$GETAPPT^BSDSCEC(DFN,TIEN,"LAST")  ;IHS/ANMC/LJF 11/1/2000
  1.  S NEXT=$$GETAPPT^BSDSCEC(DFN,TIEN,"NEXT")  ;IHS/ANMC/LJF 11/1/2000
  1.  ;I '$D(FLAG) S DATA=$$FORMAT^SCRPEC2(PTIEN,INS,TIEN,PDATA,CNAME,CIEN)
  1.  I '$D(FLAG) S DATA=$$FORMAT^SCRPEC2(NAME,PID,MT,PELIG,PSTAT,STATD,LAST,NEXT,CNAME),DATA=$E(NAME,1,12)_"^"_DATA
  1.  I $D(FLAG) S DATA=$E(NAME,1,12)_"^"_PID_"^"_MT_"^"_PELIG_"^"_PSTAT_"^"_STATD_"^"_LAST_"^"_NEXT
  1.  Q DATA
  1.  ;