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

SDECEP.m

Go to the documentation of this file.
  1. SDECEP ;SPFO/DMR,PC SCHEDULING ENHANCEMENTS VSE EP API ;Apr 02, 2020@14:27
  1. ;;5.3;Scheduling;**669,694**;Aug 13 1993;Build 61
  1. ;
  1. ;The API provides Extended Profile Appt info the VS Gui.
  1. ;INPUT - DFN required
  1. ; APP appointment date/time required
  1. Q
  1. ;
  1. CLASS(RTT,DFN,APT) ;
  1. Q:'$G(DFN)
  1. Q:'$G(APT)
  1. ;
  1. ; Each Clasification set to Not Applicable
  1. ; 1 Agent Orange Exposure: Not Applicable
  1. ; 2 Ionizing Radiation Exposure: Not Applicable
  1. ; 3 Treatment for SC Condition: Not Applicable
  1. ; 4 SW Asia Conditions: Not Applicable
  1. ; 5 Military Sexual Trauma: Not Applicable
  1. ; 6 Head and/or Neck Cancer: Not Applicable
  1. ; 7 Combat Vet (Combat Related): Not Applicable
  1. ;
  1. S APT=+APT ;strip off extra zeros on time pwc SD*5.3*694
  1. ;
  1. S NA="Not Applicable"
  1. S RTT=NA_U_NA_U_NA_U_NA_U_NA_U_NA_U_NA_U_NA
  1. ;
  1. S (ENCN,CC,CL)=""
  1. ;
  1. S ENCN=$P($G(^DPT(DFN,"S",APT,0)),"^",20)
  1. I ENCN'="" D CLOE^SDCO21(ENCN,.RR)
  1. F CC=1:1:8 S CL=$G(RR(CC)) D
  1. .I $P($G(CL),"^",2)=1 S $P(RTT,"^",CC)="YES"
  1. .I $P($G(CL),"^",2)=0 S $P(RTT,"^",CC)="NO"
  1. K ENCN,CC,CL
  1. Q
  1. ;
  1. DIAGN(REN,DFN,APP) ;
  1. Q:'$G(DFN)
  1. Q:'$G(APP)
  1. ;
  1. S APP=+APP ;strip off extra zeros on time pwc SD*5.3*694
  1. ;
  1. S (ENUM,CNT,CNT1,CC,NAME,REN)=""
  1. S ENUM=$P($G(^DPT(DFN,"S",APP,0)),"^",20)
  1. I ENUM'="" D SET^SDCO4(ENUM)
  1. Q:SDCNT=""
  1. F CC=1:1:SDCNT S ICDN=$P($G(SDDXY(CC)),"^",2) D
  1. .Q:ICDN=""
  1. .S NAME="" S NAME=$$GET1^DIQ(80,ICDN,.01)
  1. .S CNT="" S CNT=$P($G(^ICD9(ICDN,67,0)),"^",3)
  1. .S CNT1="" S CNT1=$P(^ICD9(ICDN,67,CNT,0),"^",2)
  1. .S REN=REN_NAME_" "_CNT1_"^"
  1. .Q
  1. K ENUM,CNT,CNT1,CC,NAME
  1. Q
  1. PROV(RET,DFN,APPT) ;
  1. Q:'$G(DFN)
  1. Q:'$G(APPT)
  1. ;
  1. S APPT=+APPT ;strip off extra zeros on time pwc SD*5.3*694
  1. ;
  1. S EN="" S EN=$P($G(^DPT(DFN,"S",APPT,0)),"^",20)
  1. Q:EN=""
  1. ;
  1. S (CC,NAME,NAM,RET)=""
  1. ;
  1. K PLIST
  1. D GETPRV^SDOE(EN,"PLIST")
  1. Q:PLIST=""
  1. F S CC=$O(PLIST(CC)) Q:CC="" D
  1. .S NAM="" S NAM=$P(PLIST(CC),"^",1)
  1. .S NAME="" S NAME=$$GET1^DIQ(200,NAM,.01)
  1. .I NAME'="" S RET=RET_NAME_"^"
  1. .Q
  1. K CC,NAME,NAM
  1. Q
  1. ;
  1. CPT(REC,DFN,APP) ;
  1. Q:'$G(APP)
  1. Q:'$G(DFN)
  1. ;
  1. S APP=+APP ;strip off extra zeros on time pwc SD*5.3*694
  1. ;
  1. S ENN="" S ENN=$P($G(^DPT(DFN,"S",APP,0)),"^",20)
  1. Q:ENN=""
  1. S (CNT,CC,CCC,CPT,PNAR,PNARN,QTY,CPTM,REC)=""
  1. ;
  1. K CPTL
  1. D GETCPT^SDOE(ENN,"CPTL")
  1. S CC="" F S CC=$O(CPTL(CC)) Q:CC="" D
  1. .S CPT="" S CPT=$P($G(CPTL(CC,0)),"^",1)
  1. .S QTY="" S QTY=$P($G(CPTL(CC,0)),"^",16)
  1. .S PNARN="" S PNARN=$P($G(CPTL(CC,0)),"^",4)
  1. .I PNARN'="" S PNAR="" S PNAR=$$GET1^DIQ(9999999.27,PNARN,.01)
  1. .S REC=REC_"^"_CPT_" "_QTY_" "_PNAR
  1. .I $D(CPTL(CC,1,0)) D
  1. ..S (CNN,CMM,CCC)="" S CCC=$P($G(CPTL(CC,1,0)),"^",4)
  1. ..F CNT=1:1:CCC S CNN=$P($G(CPTL(CC,1,CNT,0)),"^",1) D
  1. ...I CNN>0 D
  1. ....S CPTMN="" S CPTMN=$$GET1^DIQ(81.3,CNN,.02)
  1. ....S CMM="" S CMM=$$GET1^DIQ(81.3,CNN,.01)
  1. ...S CPTM=CPTM_":"_CMM_":"_CPTMN
  1. ...S REC=REC_CPTM
  1. ...Q
  1. K ENN,CNT,CC,CCC,CPT,PNAR,PNARN,QTY,CPTM
  1. Q
  1. ;
  1. SCODE(RTU,DFN,APP) ;
  1. Q:'$G(DFN)
  1. Q:'$G(APP)
  1. ;
  1. S APP=+APP ;strip off extra zeros on time pwc SD*5.3*694
  1. ;
  1. S ENU="" S ENU=$P($G(^DPT(DFN,"S",APP,0)),"^",20)
  1. Q:ENU=""
  1. S (SNAM,SNUM,SNAM1,SNUM1,LOC,LNUM,AMIS,AMIS1,RTU)=""
  1. ;
  1. S LNUM="" S LNUM=$P($G(^SCE(ENU,0)),"^",4)
  1. Q:LNUM=""
  1. S (SNAM,SNUM)="" S SNAM=$$GET1^DIQ(44,LNUM,8,"E") S SNUM=$$GET1^DIQ(44,LNUM,8,"I")
  1. I SNUM'="" S AMIS="" S AMIS=$$GET1^DIQ(40.7,SNUM,1)
  1. S (SNAM1,SNUM1)="" S SNAM1=$$GET1^DIQ(44,LNUM,2503,"E") S SNUM1=$$GET1^DIQ(44,LNUM,2503,"I")
  1. I SNUM1'="" S AMIS1="" S AMIS1=$$GET1^DIQ(40.7,SNUM1,1)
  1. S RTU=AMIS_" "_SNAM_"^"_AMIS1_" "_SNAM1_"^"
  1. K SNAM,SNUM,SNAM1,SNUM1,LOC,LNUM,AMIS,AMIS1
  1. Q
  1. ;
  1. INP(REN,DFN) ;
  1. Q:'$G(DFN)
  1. ;
  1. S (ADMDT,DISDT,DNUM,LSTAT,SDST,SDSTA,REN)=""
  1. I '$D(^DGPM("C",DFN)) S LSTAT="NO INPT./LOD. ACT." Q
  1. ;
  1. S VAIP("D")="L",VAIP("L")="" D INP^DGPMV10
  1. S A=$S("^3^5^"[("^"_+DGPMVI(2)_"^"):0,1:+DGPMVI(2)),SDST=$S('A:"IN",1:"")_"ACTIVE ",SDSTA=$S("^4^5^"[("^"_+DGPMVI(2)_"^"):"LODGER",1:"INPATIENT")
  1. S LSTAT="" S LSTAT=SDST_" "_SDSTA
  1. S ADMDT="" S ADMDT=$P($G(DGPMVI(13,1)),"^",2)
  1. S DNUM="" S DNUM=$G(DGPMV1(17)) I DNUM'="" D
  1. .S DISDT="" S DISDT=$$GET1^DIQ(405,DNUM,.01)
  1. S REN=LSTAT_"^"_ADMDT_"^"_DISDT
  1. K ADMDT,DISDT,DNUM,LSTAT,SDST,SDSTA
  1. Q
  1. APPT(RET,DFN1,APP1) ;
  1. Q:'$G(DFN1)
  1. Q:'$G(APP1)
  1. ;
  1. S APP1=+APP1 ;strip off extra zeros on time pwc SD*5.3*694
  1. ;
  1. S RET=$P($G(^DPT(DFN1,"S",APP1,0)),"^",2)
  1. Q