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.DOMAIN.EXT")=""
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLDUP2 3356 printed Oct 16, 2024@18:30:36 Page 2
GMPLDUP2 ;SLC/JVS -- Duplicate Problem #3
+1 ;;2.0;Problem List;**12**;Aug 25, 1994
+2 ;
+3 ;VARIABLES:
+4 ;PATIENT = Pointer to the PATIENT/IHS #9000001
+5 ;IEN,IFN = IEN of problem in PROBLEM #9000011
+6 ;ICD = Pointer to ICD DIAGNOSIS # 80
+7 ;PROBLEM = Pointer to EXPRESSIONS #757.01
+8 ;FLAG = Used to exit program
+9 ;^TMP("GMPLDUP",$J) = Storage of located duplicates
+10 ;^TMP("GMPLD") = Temporary storage for duplicates
+11 ;DUPLICAT= Local array of Current Duplicate being examined
+12 ;
+13 QUIT
TASK ;-TASK JOB
+1 SET ZTRTN="EN^GMPLDUP2"
+2 SET ZTDESC="Hide Duplicate Problem for GMPL*2*12"
+3 SET ZTDTH=$HOROLOG
+4 SET ZTSAVE=("DUZ")
+5 SET ZTIO=""
+6 DO ^%ZTLOAD
+7 IF $DATA(ZTSK)
DO BMES^XPDUTL("Task Number: "_$GET(ZTSK))
+8 IF '$DATA(ZTSK)
DO BMES^XPDUTL("TASK JOB DID NOT RUN!")
+9 IF '$DATA(ZTSK)
DO MES^XPDUTL("Start Task with D TASK^GMPLDUP2")
+10 ;
+11 QUIT
+12 ;
EN ; Official entry point
+1 ;
+2 DO SEARCH
+3 DO CLASS2
+4 DO EXIT
SEARCH ;Search for possible duplicates and locate in ^TMP("GMPLDUP")
+1 SET TOTAL=$PIECE(^AUPNPROB(0),"^",3)
+2 NEW PATIENT,IEN,ICD,PROBLEM,CNT,CNTR
+3 KILL ^TMP("GMPLD",$JOB)
+4 SET PATIENT=0
SET ICD=0
SET PROBLEM=0
SET CNT=0
SET CNTR=0
+5 FOR
SET PATIENT=$ORDER(^AUPNPROB("AC",PATIENT))
if PATIENT=""
QUIT
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNPROB("AC",PATIENT,IEN))
if IEN=""
QUIT
Begin DoDot:2
+7 if $PIECE($GET(^AUPNPROB(IEN,1)),"^",2)="H"
QUIT
+8 SET ICD=$PIECE($GET(^AUPNPROB(IEN,0)),"^",1)
+9 SET PROBLEM=$PIECE($GET(^AUPNPROB(IEN,1)),"^",1)
+10 SET CNT=CNT+1
+11 IF '$DATA(^TMP("GMPLD",$JOB,PATIENT,ICD,PROBLEM))
Begin DoDot:3
+12 SET ^TMP("GMPLD",$JOB,PATIENT,ICD,PROBLEM,IEN)=""
End DoDot:3
+13 IF '$TEST
SET ^TMP("GMPLDUP",PATIENT,ICD,PROBLEM,IEN)=""
SET ^TMP("GMPLDUP",PATIENT,ICD,PROBLEM,$ORDER(^TMP("GMPLD",$JOB,PATIENT,ICD,PROBLEM,0)))=""
SET CNTR=CNTR+1
End DoDot:2
End DoDot:1
KILL ^TMP("GMPLD",$JOB)
+14 QUIT
CLASS2 ;Eliminate Class 2 Duplicates
+1 ;
SET2 NEW IFN,DUPLICAT,PATIENT,ICD,PROBLEM,FLAG,PN,CONDITIO,STATUS
+1 NEW FACILITY,GMPLC1,DOC
+2 SET PATIENT=0
SET FLAG=1
SET CNT=0
SET CONDITIO=""
+3 ;
FIND2 ;
+1 FOR
SET PATIENT=$ORDER(^TMP("GMPLDUP",PATIENT))
if PATIENT=""
QUIT
Begin DoDot:1
+2 SET ICD=0
FOR
SET ICD=$ORDER(^TMP("GMPLDUP",PATIENT,ICD))
if ICD=""
QUIT
Begin DoDot:2
+3 SET PROBLEM=0
FOR
SET PROBLEM=$ORDER(^TMP("GMPLDUP",PATIENT,ICD,PROBLEM))
if PROBLEM=""
QUIT
Begin DoDot:3
+4 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("GMPLDUP",PATIENT,ICD,PROBLEM,IFN))
if IFN=""
QUIT
Begin DoDot:4
+5 ;---
+6 ;-Look for notes
+7 if $DATA(^AUPNPROB(IFN,11,0))
QUIT
+8 ;-Look for Verified Problem
+9 if $PIECE($GET(^AUPNPROB(IFN,1)),"^",2)="P"
QUIT
+10 ;-Look for already hidden
+11 if $PIECE($GET(^AUPNPROB(IFN,1)),"^",2)="H"
QUIT
+12 ;---
+13 SET PN=$PIECE($GET(^AUPNPROB(IFN,0)),"^",5)
+14 SET STATUS=$PIECE($GET(^AUPNPROB(IFN,0)),"^",12)
+15 SET CONDITIO=$PIECE($GET(^AUPNPROB(IFN,1)),"^",2)
+16 ;---
+17 IF '$DATA(GMPLC1(PN,STATUS,CONDITIO))
SET GMPLC1(PN,STATUS,CONDITIO)=IFN
+18 IF '$TEST
SET ^TMP("GMPLREM",IFN)=""
End DoDot:4
End DoDot:3
KILL GMPLC1
End DoDot:2
End DoDot:1
+19 DO HIDE2
QUIT
HIDE2 ;---Hide Duplicates and count them.
+1 NEW IFN,CNT,GMPIFN
+2 SET CNT=0
+3 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("GMPLREM",IFN))
if IFN=""
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
+5 SET GMPIFN=IFN
+6 DO DEL
End DoDot:1
+7 ;---Send Bulletin
+8 SET XMB="GMPL DUPLICATE PROBLEMS"
+9 SET XMDUZ=$PIECE($$SITE^VASITE,"^",2)_" "_"GMPL*2*12"
+10 SET XMY("SMITH,VAUGHN@ISC-SLC.DOMAIN.EXT")=""
+11 SET XMY(DUZ)=""
+12 SET XMB(1)=$GET(CNT)
+13 DO ^XMB
+14 ;----
+15 KILL ^TMP("GMPLREM")
+16 QUIT
DEL ; -- delete a problem
+1 NEW PROMPT,DEFAULT,X,Y,CHNGE,GMPFLD,GMPROV,GMPSAVED
+2 SET CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($HOROLOG)_U_DUZ_"^P^H^Deleted^"_+$GET(GMPROV)
+3 SET $PIECE(^AUPNPROB(GMPIFN,1),U,2)="H"
SET GMPSAVED=1
+4 DO AUDIT^GMPLX(CHNGE,"")
DO DTMOD^GMPLX(GMPIFN)
+5 QUIT
EXIT ;-KILLS GLOBALS AND EXITS
+1 KILL ^TMP("GMPLD"),^TMP("GMPLDUP"),^TMP("GMPLREM")
+2 KILL CNT,TOTAL
