- GMPLDUP2 ;SLC/JVS -- Duplicate Problem #3;18-May-2010 05:58;PLS
- ;;2.0;Problem List;**12,1001**;Aug 25, 1994;Build 9
- ;Modified - IHS/MSC/PLS - 8/5/2001 - Line SEARCH+9
- ;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) Q:'PROBLEM ;IHS/CIA/PLS 08/05/2001
- ..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
- GMPLDUP2 ;SLC/JVS -- Duplicate Problem #3;18-May-2010 05:58;PLS
- +1 ;;2.0;Problem List;**12,1001**;Aug 25, 1994;Build 9
- +2 ;Modified - IHS/MSC/PLS - 8/5/2001 - Line SEARCH+9
- +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 ;IHS/CIA/PLS 08/05/2001
- SET PROBLEM=$PIECE($GET(^AUPNPROB(IEN,1)),"^",1)
- IF 'PROBLEM
- QUIT
- +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.VA.GOV")=""
- +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
