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

CRHDPL.m

Go to the documentation of this file.
  1. CRHDPL ; CAIRO/MGH - Find personal lists for changeover list ;04-Mar-2008 16:00;CLC
  1. ;;1.0;CRHD;****;Jan 28, 2008;Build 19
  1. ;=================================================================
  1. DEFPAT(CRHDPATL,DUZ) ;Find the personal list for this person
  1. N VAIN,CRHDLIST,CRHDCT,CRHDPLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN
  1. N CRHDDOB,CRHDAGE,CRHDSEX,CRHDDSRC,CRHDJ,CRHDN,CRHDTLST
  1. S CRHDCT=0
  1. ;get default patient list
  1. D DEFSRC^ORQPTQ11(.CRHDDSRC)
  1. D DEFLIST^ORQPTQ11(.CRHDLST)
  1. I $G(CRHDDSRC)["^Combination" D
  1. .K CRHDLST
  1. .I $D(^TMP("OR",$J,"PATIENTS")) D
  1. ..S CRHDN=0
  1. ..F S CRHDN=$O(^TMP("OR",$J,"PATIENTS",CRHDN)) Q:'CRHDN S CRHDLST(CRHDN)=^TMP("OR",$J,"PATIENTS",CRHDN,0)
  1. I $D(CRHDLST) D Q
  1. .S CRHDJ=0
  1. .F S CRHDJ=$O(CRHDLST(CRHDJ)) Q:'CRHDJ D
  1. ..S CRHDDFN=+CRHDLST(CRHDJ)
  1. ..Q:'CRHDDFN
  1. ..D PATDATA(CRHDDFN,.CRHDCT)
  1. .D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
  1. .I $G(CRHDTLST)="" D DEFSRC^ORQPTQ11(.CRHDTLST)
  1. Q
  1. PERSLST(CRHDPATL,DUZ) ;
  1. ;If no patient list, get personal list
  1. D PERSPR^ORQPTQ1(.CRHDLST)
  1. I $P($G(CRHDLST(1)),U,1) D
  1. .S CRHDL=0 F S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL="" D
  1. ..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
  1. ..D GETPTS
  1. ;If no personal list, look for a default team list
  1. E D
  1. .K CRHDLST
  1. .D DEFTM^ORQPTQ1(.CRHDLST)
  1. .I '$P($G(CRHDLST),U,1) S CRHDPATL(1)=CRHDLST Q
  1. .S CRHDLIST=$P(CRHDLST,U,1)
  1. .D GETPTS
  1. Q
  1. GETPTS ;subroutine to return patients on a list
  1. N J,VADM,VAIP
  1. S J=0
  1. F S J=$O(^OR(100.21,+CRHDLIST,10,J)) Q:J<1 D
  1. .S CRHDORX=^(J,0),CRHDDFN=$P(CRHDORX,";")
  1. .D PATDATA(CRHDDFN,.CRHDCT)
  1. D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
  1. Q
  1. ALPHA(CRHDPATA,CRHDPATL,CRHDCT) ;
  1. N TXX
  1. S TXX=""
  1. F S TXX=$O(CRHDPATA(TXX)) Q:TXX="" S CRHDCT=CRHDCT+1,CRHDPATL(CRHDCT)=CRHDPATA(TXX)
  1. K CRHDPATA
  1. Q
  1. PATDATA(CRHDDFN,CRHDCT) ;
  1. ;
  1. K VAIP,VADM,DFN
  1. S DFN=CRHDDFN
  1. D DEM^VADPT,IN5^VADPT
  1. ;Outpatients not valid for changeover list
  1. ;Q:VAIP(1)=""
  1. S CRHDNAME=VADM(1),CRHDSSN=$P(VADM(2),U,1),CRHDDOB=$P(VADM(3),U,1)
  1. S CRHDAGE=VADM(4),CRHDSEX=$P(VADM(5),U,1)
  1. ;S CRHDCT=CRHDCT+1
  1. ;S CRHDPATL(CRHDCT)=CRHDDFN_U_CRHDNAME_U_CRHDSSN_U_CRHDDOB_U_CRHDAGE_U_CRHDSEX
  1. S CRHDPATA(CRHDNAME)=CRHDDFN_U_CRHDNAME_U_CRHDSSN_U_CRHDDOB_U_CRHDAGE_U_CRHDSEX
  1. Q
  1. SPECPTS(CRHDPATL,SPL) ;
  1. N VAIN,CRHDLIST,CRHDCT,CRHDLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE
  1. S CRHDCT=0
  1. D SPECPTS^ORQPTQ2(.CRHDLST,.SPL)
  1. I $P($G(CRHDLST(1)),U,1) D
  1. .S CRHDL=0 F S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL="" D
  1. ..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
  1. ..D PATDATA(CRHDLIST,.CRHDCT)
  1. .D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
  1. Q
  1. TEAM(CRHDPATL,TEAM,FLAG) ;
  1. N VAIN,CRHDLIST,CRHDCT,CRHDLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE
  1. S CRHDCT=0
  1. D TEAMPTS^ORQPTQ1(.CRHDLST,.TEAM,.FLAG)
  1. I $P($G(CRHDLST(1)),U,1) D
  1. .S CRHDL=0 F S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL="" D
  1. ..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
  1. ..D PATDATA(CRHDLIST,.CRHDCT)
  1. .D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
  1. Q
  1. PROV(CRHDPATL,PROV) ;
  1. N VAIN,CRHDLIST,CRHDCT,CRHDLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE
  1. S CRHDCT=0
  1. D PROVPTS^ORQPTQ2(.CRHDLST,.PROV)
  1. I $P($G(CRHDLST(1)),U,1) D
  1. .S CRHDL=0 F S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL="" D
  1. ..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
  1. ..D PATDATA(CRHDLIST,.CRHDCT)
  1. .D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
  1. Q
  1. WARD(CRHDPATL,WARD) ;
  1. N VAIN,CRHDLIST,CRHDCT,CRHDLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE
  1. S CRHDCT=0
  1. D BYWARD^ORWPT(.CRHDLST,.WARD)
  1. I $P($G(CRHDLST(1)),U,1) D
  1. .S CRHDL=0 F S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL="" D
  1. ..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
  1. ..D PATDATA(CRHDLIST,.CRHDCT)
  1. .D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
  1. Q