source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMGECK.m@ 636

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