100 lines
3.2 KiB
Mathematica
100 lines
3.2 KiB
Mathematica
|
GMPLDUP2 ;SLC/JVS -- Duplicate Problem #3
|
||
|
|
;;2.0;Problem List;**12**;Aug 25, 1994
|
||
|
|
;
|
||
|
|
;VARIABLES:
|
||
|
|
;PATIENT = Pointer to the PATIENT/IHS #9000001
|
||
|
|
;IEN,IFN = IEN of problem in PROBLEM #9000011
|
||
|
|
;ICD = Pointer to ICD DIAGNOSIS # 80
|
||
|
|
;PROBLEM = Pointer to EXPRESSIONS #757.01
|
||
|
|
;FLAG = Used to exit program
|
||
|
|
;^TMP("GMPLDUP",$J) = Storage of located duplicates
|
||
|
|
;^TMP("GMPLD") = Temporary storage for duplicates
|
||
|
|
;DUPLICAT= Local array of Current Duplicate being examined
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
TASK ;-TASK JOB
|
||
|
|
S ZTRTN="EN^GMPLDUP2"
|
||
|
|
S ZTDESC="Hide Duplicate Problem for GMPL*2*12"
|
||
|
|
S ZTDTH=$H
|
||
|
|
S ZTSAVE=("DUZ")
|
||
|
|
S ZTIO=""
|
||
|
|
D ^%ZTLOAD
|
||
|
|
I $D(ZTSK) D BMES^XPDUTL("Task Number: "_$G(ZTSK))
|
||
|
|
I '$D(ZTSK) D BMES^XPDUTL("TASK JOB DID NOT RUN!")
|
||
|
|
I '$D(ZTSK) D MES^XPDUTL("Start Task with D TASK^GMPLDUP2")
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EN ; Official entry point
|
||
|
|
;
|
||
|
|
D SEARCH
|
||
|
|
D CLASS2
|
||
|
|
D EXIT
|
||
|
|
SEARCH ;Search for possible duplicates and locate in ^TMP("GMPLDUP")
|
||
|
|
S TOTAL=$P(^AUPNPROB(0),"^",3)
|
||
|
|
N PATIENT,IEN,ICD,PROBLEM,CNT,CNTR
|
||
|
|
K ^TMP("GMPLD",$J)
|
||
|
|
S PATIENT=0,ICD=0,PROBLEM=0,CNT=0,CNTR=0
|
||
|
|
F S PATIENT=$O(^AUPNPROB("AC",PATIENT)) Q:PATIENT="" D K ^TMP("GMPLD",$J)
|
||
|
|
.S IEN=0 F S IEN=$O(^AUPNPROB("AC",PATIENT,IEN)) Q:IEN="" D
|
||
|
|
..Q:$P($G(^AUPNPROB(IEN,1)),"^",2)="H"
|
||
|
|
..S ICD=$P($G(^AUPNPROB(IEN,0)),"^",1)
|
||
|
|
..S PROBLEM=$P($G(^AUPNPROB(IEN,1)),"^",1)
|
||
|
|
..S CNT=CNT+1
|
||
|
|
..I '$D(^TMP("GMPLD",$J,PATIENT,ICD,PROBLEM)) D
|
||
|
|
...S ^TMP("GMPLD",$J,PATIENT,ICD,PROBLEM,IEN)=""
|
||
|
|
..E S ^TMP("GMPLDUP",PATIENT,ICD,PROBLEM,IEN)="",^TMP("GMPLDUP",PATIENT,ICD,PROBLEM,$O(^TMP("GMPLD",$J,PATIENT,ICD,PROBLEM,0)))="" S CNTR=CNTR+1
|
||
|
|
Q
|
||
|
|
CLASS2 ;Eliminate Class 2 Duplicates
|
||
|
|
;
|
||
|
|
SET2 N IFN,DUPLICAT,PATIENT,ICD,PROBLEM,FLAG,PN,CONDITIO,STATUS
|
||
|
|
N FACILITY,GMPLC1,DOC
|
||
|
|
S PATIENT=0,FLAG=1,CNT=0,CONDITIO=""
|
||
|
|
;
|
||
|
|
FIND2 ;
|
||
|
|
F S PATIENT=$O(^TMP("GMPLDUP",PATIENT)) Q:PATIENT="" D
|
||
|
|
.S ICD=0 F S ICD=$O(^TMP("GMPLDUP",PATIENT,ICD)) Q:ICD="" D
|
||
|
|
..S PROBLEM=0 F S PROBLEM=$O(^TMP("GMPLDUP",PATIENT,ICD,PROBLEM)) Q:PROBLEM="" D K GMPLC1
|
||
|
|
...S IFN=0 F S IFN=$O(^TMP("GMPLDUP",PATIENT,ICD,PROBLEM,IFN)) Q:IFN="" D
|
||
|
|
....;---
|
||
|
|
....;-Look for notes
|
||
|
|
....Q:$D(^AUPNPROB(IFN,11,0))
|
||
|
|
....;-Look for Verified Problem
|
||
|
|
....Q:$P($G(^AUPNPROB(IFN,1)),"^",2)="P"
|
||
|
|
....;-Look for already hidden
|
||
|
|
....Q:$P($G(^AUPNPROB(IFN,1)),"^",2)="H"
|
||
|
|
....;---
|
||
|
|
....S PN=$P($G(^AUPNPROB(IFN,0)),"^",5)
|
||
|
|
....S STATUS=$P($G(^AUPNPROB(IFN,0)),"^",12)
|
||
|
|
....S CONDITIO=$P($G(^AUPNPROB(IFN,1)),"^",2)
|
||
|
|
....;---
|
||
|
|
....I '$D(GMPLC1(PN,STATUS,CONDITIO)) S GMPLC1(PN,STATUS,CONDITIO)=IFN
|
||
|
|
....E S ^TMP("GMPLREM",IFN)=""
|
||
|
|
D HIDE2 Q
|
||
|
|
HIDE2 ;---Hide Duplicates and count them.
|
||
|
|
N IFN,CNT,GMPIFN
|
||
|
|
S CNT=0
|
||
|
|
S IFN=0 F S IFN=$O(^TMP("GMPLREM",IFN)) Q:IFN="" D
|
||
|
|
.S CNT=CNT+1
|
||
|
|
.S GMPIFN=IFN
|
||
|
|
.D DEL
|
||
|
|
;---Send Bulletin
|
||
|
|
S XMB="GMPL DUPLICATE PROBLEMS"
|
||
|
|
S XMDUZ=$P($$SITE^VASITE,"^",2)_" "_"GMPL*2*12"
|
||
|
|
S XMY("SMITH,VAUGHN@ISC-SLC.VA.GOV")=""
|
||
|
|
S XMY(DUZ)=""
|
||
|
|
S XMB(1)=$G(CNT)
|
||
|
|
D ^XMB
|
||
|
|
;----
|
||
|
|
K ^TMP("GMPLREM")
|
||
|
|
Q
|
||
|
|
DEL ; -- delete a problem
|
||
|
|
N PROMPT,DEFAULT,X,Y,CHNGE,GMPFLD,GMPROV,GMPSAVED
|
||
|
|
S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV)
|
||
|
|
S $P(^AUPNPROB(GMPIFN,1),U,2)="H",GMPSAVED=1
|
||
|
|
D AUDIT^GMPLX(CHNGE,""),DTMOD^GMPLX(GMPIFN)
|
||
|
|
Q
|
||
|
|
EXIT ;-KILLS GLOBALS AND EXITS
|
||
|
|
K ^TMP("GMPLD"),^TMP("GMPLDUP"),^TMP("GMPLREM")
|
||
|
|
K CNT,TOTAL
|