source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP50.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1GMRCP50 ;ISP/TDP - PRE INSTALL FOR GMRC*3*50 ; 11/29/2005
2 ;;3.0;CONSULT/REQUEST TRACKING;**50**;DEC 27, 1997;Build 8
3 Q
4EN ;Entry point for manual start from programmer's prompt
5 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,NMFLG,X,Y
6 S DIR(0)="Y"
7 S DIR("A")="Print Full Patient Names on pre-install report"
8 S DIR("B")="YES"
9 S DIR("?")="Answer 'NO' to print patients' initials and last 6 of SSN."
10 S DIR("?",1)="Answer 'YES' to print patients' full name and last 4 of SSN."
11 D ^DIR I (($G(DIROUT))!($G(DIRUT))!($G(DUOUT))!($G(DTOUT))) Q
12 S NMFLG=Y
13PRE ;Start of Pre-init of patch GMRC*3*50
14 N GMRCTTL,GMRCITL
15 K ^TMP("GMRCP50",$J),^TMP("GMRCP50 IFC",$J)
16 I '$D(NMFLG) N NMFLG D
17 . S NMFLG=$O(XPDQUES(""))
18 . S NMFLG=$G(XPDQUES(NMFLG))
19 D BMES^XPDUTL("Starting Pre-init...")
20 D BMES^XPDUTL(" Searching for ampersand (""&"") in the SIGNIFICANT FINDINGS (#15) field")
21 D MES^XPDUTL(" of the REQUEST/CONSULTATION (#123) file.")
22 D MES^XPDUTL(" ")
23 D SEARCH
24 I GMRCTTL!(GMRCITL) D MSG^GMRCP50A
25 D BMES^XPDUTL("Pre-init complete.")
26 Q
27SEARCH ;Search SIGNIFICANT FINDINGS (#15) field of the REQUEST/CONSULTATION
28 ;(#123) file for ampersand ("&").
29 N GMRC0,GMRC40,GMRCACT,GMRCACDT,GMRCADT,GMRCAIEN,GMRCCIEN,GMRCCOM
30 N GMRCCPRS,GMRCDFN,GMRCDFN1,GMRCDONE,GMRCDT,GMRCIEN,GMRCIFC,GMRCSVC
31 N GMRCSSN,GMRCSSN1,GMRCWHO
32 S (GMRCDT,GMRCITL,GMRCTTL)=0
33 F S GMRCDT=$O(^GMR(123,"B",GMRCDT)) Q:GMRCDT="" D
34 . S GMRCIEN=""
35 . F S GMRCIEN=$O(^GMR(123,"B",GMRCDT,GMRCIEN)) Q:GMRCIEN="" D
36 .. S GMRCDONE=0
37 .. S GMRC0=$G(^GMR(123,GMRCIEN,0)) I $P(GMRC0,U,19)'="&" Q
38 .. S GMRCIFC="GMRCP50"
39 .. I $P($G(^GMR(123,GMRCIEN,12)),U,5)="P" S GMRCIFC="GMRCP50 IFC"
40 .. S GMRCDFN=+$P(GMRC0,U,2) S:GMRCDFN GMRCSSN=$P($G(^DPT(GMRCDFN,0)),U,9),GMRCDFN=$P($G(^DPT(GMRCDFN,0)),U,1)
41 .. S GMRCSSN1="("_$E(GMRCDFN,1)_$E(GMRCSSN,6,9)_")"
42 .. S GMRCDFN1=GMRCDFN
43 .. I (GMRCDFN=0)!(GMRCDFN="") S GMRCDFN="PATIENT UNKNOWN"
44 .. S GMRCDFN=GMRCDFN_" "_GMRCSSN1
45 .. S GMRCSVC=+$P(GMRC0,U,5) S:GMRCSVC GMRCSVC=$P($G(^GMR(123.5,GMRCSVC,0)),U,1)
46 .. I (GMRCSVC=0)!(GMRCSVC="") S GMRCSVC="SERVICE UNKNOWN"
47 .. S GMRCCPRS=+$P(GMRC0,U,12) S:GMRCCPRS GMRCCPRS=$P($G(^ORD(100.01,GMRCCPRS,0)),U,1)
48 .. I (GMRCCPRS=0)!(GMRCCPRS="") S GMRCCPRS="STATUS UNKNOWN"
49 .. D ACTIVITY
50 .. S ^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT,GMRCIEN,0)=GMRCIEN_U_GMRCSVC_U_GMRCCPRS_U_GMRCACT_U_GMRCACDT_U_GMRCWHO
51 .. I 'NMFLG D
52 ... S ^TMP(GMRCIFC,$J,GMRCDFN,0)="("_$E($P(GMRCDFN1,",",2),1)_$E($P($P(GMRCDFN1,",",2)," ",2),1)_$E(GMRCDFN1,1)_$E(GMRCSSN,4,9)_")"
53 .. W !," Consult entry "_GMRCIEN_" has an ampersand (""&"") as the Significant Finding."
54 .. S GMRCTTL=GMRCTTL+1
55 .. I GMRCIFC="GMRCP50 IFC" S GMRCITL=GMRCITL+1
56 D MES^XPDUTL(" ")
57 D BMES^XPDUTL(GMRCTTL_" total consults contain an ampersand as the Significant Finding.")
58 Q
59ACTIVITY ;Search thru all Request Processing Activities and return any
60 ;Significant Findings or Administrative Completions.
61 N GMRCSIG,GMRCFLG
62 S GMRCSIG=$O(^GMR(123.1,"B","SIG FINDING UPDATE",""))
63 S GMRCFLG=0
64ACT1 S (GMRCACDT,GMRCACT,GMRCADT,GMRCWHO)=""
65 F S GMRCADT=$O(^GMR(123,GMRCIEN,40,"B",GMRCADT),-1) Q:GMRCADT="" D Q:GMRCDONE
66 . S GMRCAIEN=""
67 . F S GMRCAIEN=$O(^GMR(123,GMRCIEN,40,"B",GMRCADT,GMRCAIEN)) Q:GMRCAIEN="" D Q:GMRCDONE
68 .. S GMRC40=$G(^GMR(123,GMRCIEN,40,GMRCAIEN,0)) I $P(GMRC40,U,2)'=GMRCSIG Q
69 .. S GMRCACT=+$P(GMRC40,U,2) S:GMRCACT GMRCACT=$P($G(^GMR(123.1,GMRCACT,0)),U,1)
70 .. I (GMRCACT=0)!(GMRCACT="") S GMRCACT="ACTIVITY UNKNOWN"
71 .. S GMRCACDT=+$P(GMRC40,U,3)
72 .. S GMRCWHO=+$P(GMRC40,U,4) S:'GMRCWHO GMRCWHO=+$P(GMRC40,U,5)
73 .. I 'GMRCWHO S GMRCWHO=$P($G(^GMR(123,GMRCIEN,40,GMRCAIEN,2)),U,2) S:'GMRCWHO GMRCWHO=$P($G(^GMR(123,GMRCIEN,40,GMRCAIEN,2)),U,1)
74 .. S:+GMRCWHO GMRCWHO=$P($G(^VA(200,GMRCWHO,0)),U,1)
75 .. I (GMRCWHO=0)!(GMRCWHO="") S GMRCWHO="RESP. PERSON UNKNOWN"
76 .. D COMMENT
77 .. S GMRCDONE=1
78 I 'GMRCDONE,'GMRCFLG S GMRCSIG=$O(^GMR(123.1,"B","COMPLETE/UPDATE","")),GMRCFLG=1 D ACT1
79 Q
80COMMENT ;Gather comment for Activity
81 I '$D(^GMR(123,GMRCIEN,40,GMRCAIEN,1,0)) Q
82 S GMRCCIEN=0
83 F S GMRCCIEN=$O(^GMR(123,GMRCIEN,40,GMRCAIEN,1,GMRCCIEN)) Q:GMRCCIEN="" D
84 . S GMRCCOM=$G(^GMR(123,GMRCIEN,40,GMRCAIEN,1,GMRCCIEN,0))
85 . I GMRCCOM="" S GMRCCOM="NO COMMENT AVAILABLE"
86 . S ^TMP(GMRCIFC,$J,GMRCDFN,GMRCDT,GMRCIEN,GMRCCIEN)=GMRCCOM
87 Q
Note: See TracBrowser for help on using the repository browser.