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

PXRMGECK.m

Go to the documentation of this file.
  1. PXRMGECK ;SLC/AGP,JVS-GEC Utilities Cont. ;7/14/05 10:42
  1. ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
  1. ;
  1. Q
  1. TIUSTAT(DFN,GEC) ;Status of TIU Notes
  1. N TIUDA,IEN,TITLE,NTTYP,STATUS,STATDA,STATUS,AUTDA,AUTHOR,DATE,DATEFM
  1. Q:'$D(^PXRMD(801.5,"B",DFN)) 0
  1. Q:'$D(^PXRMD(801.5,"AD",DFN,GEC)) 0
  1. S IEN=$O(^PXRMD(801.5,"AD",DFN,GEC,0))
  1. S TIUDA=$P($G(^PXRMD(801.5,IEN,0)),"^",4)
  1. Q:TIUDA="" 0
  1. Q:'$D(^TIU(8925,TIUDA,0)) 0
  1. S NTTYP=$P($G(^TIU(8925,TIUDA,0)),"^",1)
  1. S TITLE=$P($G(^TIU(8925.1,NTTYP,0)),"^",1)
  1. S STATDA=$P($G(^TIU(8925,TIUDA,0)),"^",5)
  1. S STATUS=$P($G(^TIU(8925.6,STATDA,0)),"^",1)
  1. S AUTDA=$P($G(^TIU(8925,TIUDA,12)),"^",2) D
  1. .I AUTDA="" S AUTHOR="unknown" Q
  1. .S AUTHOR=$$GET1^DIQ(200,AUTDA,.01)
  1. S DATEFM=$P($G(^TIU(8925,TIUDA,12)),"^",1) D
  1. .I DATEFM="" S DATE="unknown" Q
  1. .S DATE=$$FMTE^XLFDT(DATEFM,"D2")
  1. Q 1_"^"_TITLE_":"_STATUS_":"_AUTHOR_":"_DATE
  1. ;
  1. ACOPYDEL ;clean out ACOPY nodes
  1. N NIEN,STATUS,STIEN,NOTEDFN,CDFN,EDT,GEC,DATE
  1. Q:'$D(^PXRMD(801.5,"ACOPY"))
  1. S NIEN=0 F S NIEN=$O(^PXRMD(801.5,"ACOPY",NIEN)) Q:NIEN="" D
  1. .Q:'$D(^TIU(8925,NIEN))
  1. .S STIEN=$P($G(^TIU(8925,NIEN,0)),"^",5)
  1. .S STATUS=$P($G(^TIU(8925.6,STIEN,0)),"^",1)
  1. .I STATUS="COMPLETED" K ^PXRMD(801.5,"ACOPY",NIEN)
  1. .S NOTEDFN=$P($G(^TIU(8925,NIEN,0)),"^",2)
  1. .S CDFN=0 F S CDFN=$O(^PXRMD(801.5,"ACOPY",NIEN,CDFN)) Q:CDFN="" D
  1. ..I NOTEDFN'=CDFN K ^PXRMD(801.5,"ACOPY",NIEN,CDFN)
  1. S NIEN=0 F S NIEN=$O(^PXRMD(801.5,"ACOPY",NIEN)) Q:NIEN="" D
  1. .S CDFN=0 F S CDFN=$O(^PXRMD(801.5,"ACOPY",NIEN,CDFN)) Q:CDFN="" D
  1. ..S EDT=0 F S EDT=$O(^PXRMD(801.5,"ACOPY",NIEN,CDFN,EDT)) Q:EDT="" D
  1. ...S GEC="" F S GEC=$O(^PXRMD(801.5,"ACOPY",NIEN,CDFN,EDT,GEC)) Q:GEC="" D
  1. ....S DATE=$O(^PXRMD(801.5,"ACOPY",NIEN,CDFN,EDT,GEC,0))
  1. ....I '$D(^TIU(8925,NIEN)),$$FMDIFF^XLFDT(DT,DATE,1)>1 D
  1. .....K ^PXRMD(801.5,"ACOPY",NIEN,CDFN,EDT,GEC)
  1. Q
  1. ;
  1. ;
  1. REMOVE ;DELETE HEALTH FACTORS
  1. N NODE0,NODE12,NODE812,VISIT,PKG,VAL,PCEARY
  1. Q:'$D(HFARY)
  1. S PCEARY="^TMP(""PXRMGECZ"",$J)"
  1. S HFDA=0 F S HFDA=$O(HFARY(HFDA)) Q:HFDA="" D
  1. .N NODE0,NODE12,NODE812
  1. .S NODE0=$G(^AUPNVHF(HFDA,0))
  1. .S NODE12=$G(^AUPNVHF(HFDA,12))
  1. .S NODE812=$G(^AUPNVHF(HFDA,812))
  1. .S VISIT=$P(NODE0,"^",3)
  1. .S PKG=$P(NODE812,"^",2)
  1. .S ^TMP("PXRMGECZ",$J,"HEALTH FACTOR",HFDA,"HEALTH FACTOR")=$P(NODE0,"^",1)
  1. .S ^TMP("PXRMGECZ",$J,"HEALTH FACTOR",HFDA,"ENC PROVIDER")=$P(NODE12,"^",4)
  1. .S ^TMP("PXRMGECZ",$J,"HEALTH FACTOR",HFDA,"EVENT D/T")=$P(NODE12,"^",1)
  1. .S ^TMP("PXRMGECZ",$J,"HEALTH FACTOR",HFDA,"DELETE")=1
  1. S VAL=$$DATA2PCE^PXAPI(PCEARY,PKG,GECT,VISIT)
  1. K ^TMP("PXRMGECZ",$J)
  1. ;
  1. Q
  1. UPDATE(DFN,VISIT) ;Remove entry from 801.5 if deleted by dialog/tiu
  1. ;
  1. N HFDA,COUNT,SOURCE,GEC1,GEC2,GEC3,GECF,ENCDT,WHICH
  1. N HERE,NOT,DA,DIA
  1. Q:DFN=""
  1. ;
  1. ;Delete Health Factors if not TIU document
  1. ;
  1. S ENCDT=$O(^PXRMD(801.5,"AC",DFN,""))
  1. Q:ENCDT=""
  1. ;
  1. S (GEC1,GEC2,GEC3,GECF)=0
  1. ;GET IEN FOR DATA SOURCES FOR GEC
  1. I $D(^PX(839.7,"B","GEC1")) D
  1. .S GEC1=$O(^PX(839.7,"B","GEC1","")),WHICH(GEC1)="GEC1",NOT("GEC1")=""
  1. I $D(^PX(839.7,"B","GEC2")) D
  1. .S GEC2=$O(^PX(839.7,"B","GEC2","")),WHICH(GEC2)="GEC2",NOT("GEC2")=""
  1. I $D(^PX(839.7,"B","GEC3")) D
  1. .S GEC3=$O(^PX(839.7,"B","GEC3","")),WHICH(GEC3)="GEC3",NOT("GEC3")=""
  1. I $D(^PX(839.7,"B","GECF")) D
  1. .S GECF=$O(^PX(839.7,"B","GECF","")),WHICH(GECF)="GECF",NOT("GECF")=""
  1. ;
  1. ;
  1. S COUNT=0
  1. S HFDA="" F S HFDA=$O(^AUPNVHF("C",DFN,HFDA)) Q:HFDA="" D
  1. .I $D(^AUPNVHF(HFDA,12)) D
  1. ..I $P($G(^AUPNVHF(HFDA,12)),"^",1)=ENCDT D
  1. ...S SOURCE=$P($G(^AUPNVHF(HFDA,812)),"^",3)
  1. ...Q:SOURCE=""
  1. ...I (SOURCE=$G(GEC1))!(SOURCE=$G(GEC2))!(SOURCE=$G(GEC3))!(SOURCE=$G(GECF)) D
  1. ....S HERE($G(WHICH(SOURCE)))=""
  1. ....K NOT($G(WHICH(SOURCE)))
  1. ....S COUNT=COUNT+1
  1. S DIA="" F S DIA=$O(NOT(DIA)) Q:DIA="" D
  1. .S DA=$O(^PXRMD(801.5,"AD",DFN,DIA,0))
  1. .Q:DA=""
  1. .S ^PXRMD(801.5,"ACOPY",DFN,ENCDT,DIA)=$P($G(^PXRMD(801.5,DA,0)),"^",4)
  1. .S DIK="^PXRMD(801.5," D ^DIK
  1. Q
  1. ;
  1. ;