- 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
- ;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMGECK 3967 printed Jan 18, 2025@02:46:56 Page 2
- PXRMGECK ;SLC/AGP,JVS-GEC Utilities Cont. ;7/14/05 10:42
- +1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
- +2 ;
- +3 QUIT
- TIUSTAT(DFN,GEC) ;Status of TIU Notes
- +1 NEW TIUDA,IEN,TITLE,NTTYP,STATUS,STATDA,STATUS,AUTDA,AUTHOR,DATE,DATEFM
- +2 if '$DATA(^PXRMD(801.5,"B",DFN))
- QUIT 0
- +3 if '$DATA(^PXRMD(801.5,"AD",DFN,GEC))
- QUIT 0
- +4 SET IEN=$ORDER(^PXRMD(801.5,"AD",DFN,GEC,0))
- +5 SET TIUDA=$PIECE($GET(^PXRMD(801.5,IEN,0)),"^",4)
- +6 if TIUDA=""
- QUIT 0
- +7 if '$DATA(^TIU(8925,TIUDA,0))
- QUIT 0
- +8 SET NTTYP=$PIECE($GET(^TIU(8925,TIUDA,0)),"^",1)
- +9 SET TITLE=$PIECE($GET(^TIU(8925.1,NTTYP,0)),"^",1)
- +10 SET STATDA=$PIECE($GET(^TIU(8925,TIUDA,0)),"^",5)
- +11 SET STATUS=$PIECE($GET(^TIU(8925.6,STATDA,0)),"^",1)
- +12 SET AUTDA=$PIECE($GET(^TIU(8925,TIUDA,12)),"^",2)
- Begin DoDot:1
- +13 IF AUTDA=""
- SET AUTHOR="unknown"
- QUIT
- +14 SET AUTHOR=$$GET1^DIQ(200,AUTDA,.01)
- End DoDot:1
- +15 SET DATEFM=$PIECE($GET(^TIU(8925,TIUDA,12)),"^",1)
- Begin DoDot:1
- +16 IF DATEFM=""
- SET DATE="unknown"
- QUIT
- +17 SET DATE=$$FMTE^XLFDT(DATEFM,"D2")
- End DoDot:1
- +18 QUIT 1_"^"_TITLE_":"_STATUS_":"_AUTHOR_":"_DATE
- +19 ;
- ACOPYDEL ;clean out ACOPY nodes
- +1 NEW NIEN,STATUS,STIEN,NOTEDFN,CDFN,EDT,GEC,DATE
- +2 if '$DATA(^PXRMD(801.5,"ACOPY"))
- QUIT
- +3 SET NIEN=0
- FOR
- SET NIEN=$ORDER(^PXRMD(801.5,"ACOPY",NIEN))
- if NIEN=""
- QUIT
- Begin DoDot:1
- +4 if '$DATA(^TIU(8925,NIEN))
- QUIT
- +5 SET STIEN=$PIECE($GET(^TIU(8925,NIEN,0)),"^",5)
- +6 SET STATUS=$PIECE($GET(^TIU(8925.6,STIEN,0)),"^",1)
- +7 IF STATUS="COMPLETED"
- KILL ^PXRMD(801.5,"ACOPY",NIEN)
- +8 SET NOTEDFN=$PIECE($GET(^TIU(8925,NIEN,0)),"^",2)
- +9 SET CDFN=0
- FOR
- SET CDFN=$ORDER(^PXRMD(801.5,"ACOPY",NIEN,CDFN))
- if CDFN=""
- QUIT
- Begin DoDot:2
- +10 IF NOTEDFN'=CDFN
- KILL ^PXRMD(801.5,"ACOPY",NIEN,CDFN)
- End DoDot:2
- End DoDot:1
- +11 SET NIEN=0
- FOR
- SET NIEN=$ORDER(^PXRMD(801.5,"ACOPY",NIEN))
- if NIEN=""
- QUIT
- Begin DoDot:1
- +12 SET CDFN=0
- FOR
- SET CDFN=$ORDER(^PXRMD(801.5,"ACOPY",NIEN,CDFN))
- if CDFN=""
- QUIT
- Begin DoDot:2
- +13 SET EDT=0
- FOR
- SET EDT=$ORDER(^PXRMD(801.5,"ACOPY",NIEN,CDFN,EDT))
- if EDT=""
- QUIT
- Begin DoDot:3
- +14 SET GEC=""
- FOR
- SET GEC=$ORDER(^PXRMD(801.5,"ACOPY",NIEN,CDFN,EDT,GEC))
- if GEC=""
- QUIT
- Begin DoDot:4
- +15 SET DATE=$ORDER(^PXRMD(801.5,"ACOPY",NIEN,CDFN,EDT,GEC,0))
- +16 IF '$DATA(^TIU(8925,NIEN))
- IF $$FMDIFF^XLFDT(DT,DATE,1)>1
- Begin DoDot:5
- +17 KILL ^PXRMD(801.5,"ACOPY",NIEN,CDFN,EDT,GEC)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 QUIT
- +19 ;
- +20 ;
- REMOVE ;DELETE HEALTH FACTORS
- +1 NEW NODE0,NODE12,NODE812,VISIT,PKG,VAL,PCEARY
- +2 if '$DATA(HFARY)
- QUIT
- +3 SET PCEARY="^TMP(""PXRMGECZ"",$J)"
- +4 SET HFDA=0
- FOR
- SET HFDA=$ORDER(HFARY(HFDA))
- if HFDA=""
- QUIT
- Begin DoDot:1
- +5 NEW NODE0,NODE12,NODE812
- +6 SET NODE0=$GET(^AUPNVHF(HFDA,0))
- +7 SET NODE12=$GET(^AUPNVHF(HFDA,12))
- +8 SET NODE812=$GET(^AUPNVHF(HFDA,812))
- +9 SET VISIT=$PIECE(NODE0,"^",3)
- +10 SET PKG=$PIECE(NODE812,"^",2)
- +11 SET ^TMP("PXRMGECZ",$JOB,"HEALTH FACTOR",HFDA,"HEALTH FACTOR")=$PIECE(NODE0,"^",1)
- +12 SET ^TMP("PXRMGECZ",$JOB,"HEALTH FACTOR",HFDA,"ENC PROVIDER")=$PIECE(NODE12,"^",4)
- +13 SET ^TMP("PXRMGECZ",$JOB,"HEALTH FACTOR",HFDA,"EVENT D/T")=$PIECE(NODE12,"^",1)
- +14 SET ^TMP("PXRMGECZ",$JOB,"HEALTH FACTOR",HFDA,"DELETE")=1
- End DoDot:1
- +15 SET VAL=$$DATA2PCE^PXAPI(PCEARY,PKG,GECT,VISIT)
- +16 KILL ^TMP("PXRMGECZ",$JOB)
- +17 ;
- +18 QUIT
- UPDATE(DFN,VISIT) ;Remove entry from 801.5 if deleted by dialog/tiu
- +1 ;
- +2 NEW HFDA,COUNT,SOURCE,GEC1,GEC2,GEC3,GECF,ENCDT,WHICH
- +3 NEW HERE,NOT,DA,DIA
- +4 if DFN=""
- QUIT
- +5 ;
- +6 ;Delete Health Factors if not TIU document
- +7 ;
- +8 SET ENCDT=$ORDER(^PXRMD(801.5,"AC",DFN,""))
- +9 if ENCDT=""
- QUIT
- +10 ;
- +11 SET (GEC1,GEC2,GEC3,GECF)=0
- +12 ;GET IEN FOR DATA SOURCES FOR GEC
- +13 IF $DATA(^PX(839.7,"B","GEC1"))
- Begin DoDot:1
- +14 SET GEC1=$ORDER(^PX(839.7,"B","GEC1",""))
- SET WHICH(GEC1)="GEC1"
- SET NOT("GEC1")=""
- End DoDot:1
- +15 IF $DATA(^PX(839.7,"B","GEC2"))
- Begin DoDot:1
- +16 SET GEC2=$ORDER(^PX(839.7,"B","GEC2",""))
- SET WHICH(GEC2)="GEC2"
- SET NOT("GEC2")=""
- End DoDot:1
- +17 IF $DATA(^PX(839.7,"B","GEC3"))
- Begin DoDot:1
- +18 SET GEC3=$ORDER(^PX(839.7,"B","GEC3",""))
- SET WHICH(GEC3)="GEC3"
- SET NOT("GEC3")=""
- End DoDot:1
- +19 IF $DATA(^PX(839.7,"B","GECF"))
- Begin DoDot:1
- +20 SET GECF=$ORDER(^PX(839.7,"B","GECF",""))
- SET WHICH(GECF)="GECF"
- SET NOT("GECF")=""
- End DoDot:1
- +21 ;
- +22 ;
- +23 SET COUNT=0
- +24 SET HFDA=""
- FOR
- SET HFDA=$ORDER(^AUPNVHF("C",DFN,HFDA))
- if HFDA=""
- QUIT
- Begin DoDot:1
- +25 IF $DATA(^AUPNVHF(HFDA,12))
- Begin DoDot:2
- +26 IF $PIECE($GET(^AUPNVHF(HFDA,12)),"^",1)=ENCDT
- Begin DoDot:3
- +27 SET SOURCE=$PIECE($GET(^AUPNVHF(HFDA,812)),"^",3)
- +28 if SOURCE=""
- QUIT
- +29 IF (SOURCE=$GET(GEC1))!(SOURCE=$GET(GEC2))!(SOURCE=$GET(GEC3))!(SOURCE=$GET(GECF))
- Begin DoDot:4
- +30 SET HERE($GET(WHICH(SOURCE)))=""
- +31 KILL NOT($GET(WHICH(SOURCE)))
- +32 SET COUNT=COUNT+1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +33 SET DIA=""
- FOR
- SET DIA=$ORDER(NOT(DIA))
- if DIA=""
- QUIT
- Begin DoDot:1
- +34 SET DA=$ORDER(^PXRMD(801.5,"AD",DFN,DIA,0))
- +35 if DA=""
- QUIT
- +36 SET ^PXRMD(801.5,"ACOPY",DFN,ENCDT,DIA)=$PIECE($GET(^PXRMD(801.5,DA,0)),"^",4)
- +37 SET DIK="^PXRMD(801.5,"
- DO ^DIK
- End DoDot:1
- +38 QUIT
- +39 ;
- +40 ;