source: WorldVistAEHR/trunk/r/PROBLEM_LIST-GMPL/GMPLDUP2.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1GMPLDUP2 ;SLC/JVS -- Duplicate Problem #3
2 ;;2.0;Problem List;**12**;Aug 25, 1994
3 ;
4 ;VARIABLES:
5 ;PATIENT = Pointer to the PATIENT/IHS #9000001
6 ;IEN,IFN = IEN of problem in PROBLEM #9000011
7 ;ICD = Pointer to ICD DIAGNOSIS # 80
8 ;PROBLEM = Pointer to EXPRESSIONS #757.01
9 ;FLAG = Used to exit program
10 ;^TMP("GMPLDUP",$J) = Storage of located duplicates
11 ;^TMP("GMPLD") = Temporary storage for duplicates
12 ;DUPLICAT= Local array of Current Duplicate being examined
13 ;
14 Q
15TASK ;-TASK JOB
16 S ZTRTN="EN^GMPLDUP2"
17 S ZTDESC="Hide Duplicate Problem for GMPL*2*12"
18 S ZTDTH=$H
19 S ZTSAVE=("DUZ")
20 S ZTIO=""
21 D ^%ZTLOAD
22 I $D(ZTSK) D BMES^XPDUTL("Task Number: "_$G(ZTSK))
23 I '$D(ZTSK) D BMES^XPDUTL("TASK JOB DID NOT RUN!")
24 I '$D(ZTSK) D MES^XPDUTL("Start Task with D TASK^GMPLDUP2")
25 ;
26 Q
27 ;
28EN ; Official entry point
29 ;
30 D SEARCH
31 D CLASS2
32 D EXIT
33SEARCH ;Search for possible duplicates and locate in ^TMP("GMPLDUP")
34 S TOTAL=$P(^AUPNPROB(0),"^",3)
35 N PATIENT,IEN,ICD,PROBLEM,CNT,CNTR
36 K ^TMP("GMPLD",$J)
37 S PATIENT=0,ICD=0,PROBLEM=0,CNT=0,CNTR=0
38 F S PATIENT=$O(^AUPNPROB("AC",PATIENT)) Q:PATIENT="" D K ^TMP("GMPLD",$J)
39 .S IEN=0 F S IEN=$O(^AUPNPROB("AC",PATIENT,IEN)) Q:IEN="" D
40 ..Q:$P($G(^AUPNPROB(IEN,1)),"^",2)="H"
41 ..S ICD=$P($G(^AUPNPROB(IEN,0)),"^",1)
42 ..S PROBLEM=$P($G(^AUPNPROB(IEN,1)),"^",1)
43 ..S CNT=CNT+1
44 ..I '$D(^TMP("GMPLD",$J,PATIENT,ICD,PROBLEM)) D
45 ...S ^TMP("GMPLD",$J,PATIENT,ICD,PROBLEM,IEN)=""
46 ..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
47 Q
48CLASS2 ;Eliminate Class 2 Duplicates
49 ;
50SET2 N IFN,DUPLICAT,PATIENT,ICD,PROBLEM,FLAG,PN,CONDITIO,STATUS
51 N FACILITY,GMPLC1,DOC
52 S PATIENT=0,FLAG=1,CNT=0,CONDITIO=""
53 ;
54FIND2 ;
55 F S PATIENT=$O(^TMP("GMPLDUP",PATIENT)) Q:PATIENT="" D
56 .S ICD=0 F S ICD=$O(^TMP("GMPLDUP",PATIENT,ICD)) Q:ICD="" D
57 ..S PROBLEM=0 F S PROBLEM=$O(^TMP("GMPLDUP",PATIENT,ICD,PROBLEM)) Q:PROBLEM="" D K GMPLC1
58 ...S IFN=0 F S IFN=$O(^TMP("GMPLDUP",PATIENT,ICD,PROBLEM,IFN)) Q:IFN="" D
59 ....;---
60 ....;-Look for notes
61 ....Q:$D(^AUPNPROB(IFN,11,0))
62 ....;-Look for Verified Problem
63 ....Q:$P($G(^AUPNPROB(IFN,1)),"^",2)="P"
64 ....;-Look for already hidden
65 ....Q:$P($G(^AUPNPROB(IFN,1)),"^",2)="H"
66 ....;---
67 ....S PN=$P($G(^AUPNPROB(IFN,0)),"^",5)
68 ....S STATUS=$P($G(^AUPNPROB(IFN,0)),"^",12)
69 ....S CONDITIO=$P($G(^AUPNPROB(IFN,1)),"^",2)
70 ....;---
71 ....I '$D(GMPLC1(PN,STATUS,CONDITIO)) S GMPLC1(PN,STATUS,CONDITIO)=IFN
72 ....E S ^TMP("GMPLREM",IFN)=""
73 D HIDE2 Q
74HIDE2 ;---Hide Duplicates and count them.
75 N IFN,CNT,GMPIFN
76 S CNT=0
77 S IFN=0 F S IFN=$O(^TMP("GMPLREM",IFN)) Q:IFN="" D
78 .S CNT=CNT+1
79 .S GMPIFN=IFN
80 .D DEL
81 ;---Send Bulletin
82 S XMB="GMPL DUPLICATE PROBLEMS"
83 S XMDUZ=$P($$SITE^VASITE,"^",2)_" "_"GMPL*2*12"
84 S XMY("SMITH,VAUGHN@ISC-SLC.VA.GOV")=""
85 S XMY(DUZ)=""
86 S XMB(1)=$G(CNT)
87 D ^XMB
88 ;----
89 K ^TMP("GMPLREM")
90 Q
91DEL ; -- delete a problem
92 N PROMPT,DEFAULT,X,Y,CHNGE,GMPFLD,GMPROV,GMPSAVED
93 S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV)
94 S $P(^AUPNPROB(GMPIFN,1),U,2)="H",GMPSAVED=1
95 D AUDIT^GMPLX(CHNGE,""),DTMOD^GMPLX(GMPIFN)
96 Q
97EXIT ;-KILLS GLOBALS AND EXITS
98 K ^TMP("GMPLD"),^TMP("GMPLDUP"),^TMP("GMPLREM")
99 K CNT,TOTAL
Note: See TracBrowser for help on using the repository browser.