source: FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRC3P52.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1GMRC3P52 ;ALB/MRY - POST INIT ;04/14/06
2 ;;3.0;CONSULT/REQUEST TRACKING;**52**;DEC 27, 1997
3 ;
4EN ;
5 S XPDABORT=""
6 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D G ABRT
7 . D BMES^XPDUTL("*****")
8 . D MES^XPDUTL("Your programming variables are not set up properly.")
9 . D MES^XPDUTL("Installation aborted.")
10 W !!,">> Environment check complete and okay."
11 I XPDABORT="" K XPDABORT
12 Q
13 ;
14ABRT ; Abort transport, but leave in ^XTMP.
15 S XPDABORT=2 Q
16 ;
17PRE ;Set seed flag, so, 'AHST' xref of the new Consult Link field (#688)
18 ;of the Hospital Location file (#44) doesn't get set during install.
19 S SDSEED=1
20 Q
21POST ;-------------------------------------------------------------------
22 ;Add option to menu.
23 N GMRCOK
24 S GMRCOK=$$ADD^XPDMENU("GMRC REPORTS","GMRC RPT SD SCH-MGT CONSULTS","SH",6)
25 D BMES^XPDUTL("*****")
26 I GMRCOK=1 D
27 .D MES^XPDUTL("Adding option 'Service Consults Schedule-Management Report'")
28 .D MES^XPDUTL(" to 'Consult Tracking Reports' menu.")
29 E D
30 .D MES^XPDUTL("Error - 'Service Consults Schedule-Management Report' option not added.")
31 .D BMES^XPDUTL("*****")
32 ;
33 ;---------------------------------------------------------------------
34 ;Post-init for sites running Class 3 software.
35 ;
36 ;Quit, if Class 3 field not installed.
37 ;
38 ;File 123.5
39 ; Loop down Class 3 ^GMR("AB" xref. to build new entries.
40 ; Sites can remove Class 3 field when satisfied of changes.
41 ;
42 ;---------------------------------------------------------------------
43 ;Convert #123.5 Class 3 ASSOCIATED STOP CODE field and xrefs.
44 I '$D(^GMR(123.5,"AB")),'$D(^XTMP("GMRC3P52")) Q ;quit, no Class 3 data.
45 D BMES^XPDUTL("*****")
46 N GMRX,GMRDA,GMRSTOP,DIC
47 ;Check/create ^XTMP for conversion run to completion.
48 I $D(^XTMP("GMRC3P52")) D I $G(GMRSTOP) G CONS
49 . I $P($G(^XTMP("GMRC3P52",1)),U,2)="DONE" D
50 .. S GMRSTOP=1
51 .. D MES^XPDUTL("Conversion of Class III Associated Stop Codes already run to completion.")
52 .. D MES^XPDUTL(" ")
53 . E S GMRX=+$P($G(^XTMP("GMRC3P52",1)),U)
54 E S ^XTMP("GMRC3P52",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
55 D MES^XPDUTL("...Moving File #123.5, ASSOCIATED STOP CODE (Class 3) field entries...")
56 D MES^XPDUTL(" ")
57 I $G(GMRX)']0 S GMRX=0
58 F S GMRX=$O(^GMR(123.5,"AB",GMRX)) Q:'GMRX D
59 . S GMRDA=0 F S GMRDA=$O(^GMR(123.5,"AB",GMRX,GMRDA)) Q:'GMRDA D
60 .. ;check for duplicate. FILE^DICN call will add duplicates.
61 .. I +$O(^GMR(123.5,"AB1",GMRX,GMRDA,0)) Q
62 .. K DIC("DR")
63 .. S DA(1)=GMRDA
64 .. S DIC="^GMR(123.5,"_DA(1)_",688,"
65 .. S DIC(0)="L",DIC("P")=$P(^DD(123.5,688,0),"^",2)
66 .. S DIC("DR")="688///"_GMRX
67 .. S X=GMRX
68 .. K D0 D FILE^DICN
69 .. I Y=-1 Q
70 .. S $P(^XTMP("GMRC3P52",1),U)=GMRX
71 S $P(^XTMP("GMRC3P52",1),U,2)="DONE"
72 ;
73CONS ;---------------------------------------------------------------------
74 ;Post-init for sites running Class 3 software.
75 ;
76 ;Quit, if Class 3 field not installed.
77 ;
78 ;File 44
79 ; Loop down Class 3 ^SC("AWAS" xref. to build new entries.
80 ;---------------------------------------------------------------------
81 ;
82 ;Convert HOSPITAL LOCATION Class III CONSULT LINK field and xrefs.
83 I '$D(^SC("AWAS")),'$D(^XTMP("SD53P478")) Q ;quit, no Class 3 data
84 N CNSLTLNK,SDC,SDT,SDY,DA,DIE,DR,SDSTOP
85 ;Check/create ^XTMP for conversion run to completion.
86 I $D(^XTMP("SD53P478")) D I $G(SDSTOP) Q
87 . I $P($G(^XTMP("SD53P478",1)),U,2)="DONE" D
88 .. S SDSTOP=1
89 .. D MES^XPDUTL("Conversion of Class III Consult Link entries already run to completion.")
90 .. D MES^XPDUTL(" ")
91 . E S CNSLTLNK=+$P($G(^XTMP("SD53P478",1)),U)
92 E S ^XTMP("SD53P478",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
93 D MES^XPDUTL("...Moving File #44, CONSULT LINK (Class 3) field entries...")
94 ;Loop down Class III CONSULT LINK "AWAS" xref (if exits).
95 I $G(CNSLTLNK)']0 S CNSLTLNK=0
96 F S CNSLTLNK=$O(^SC("AWAS",CNSLTLNK)) Q:'CNSLTLNK D
97 .S SDC=0 F S SDC=$O(^SC("AWAS",CNSLTLNK,SDC)) Q:'SDC D
98 ..S SDT=0 F S SDT=$O(^SC("AWAS",CNSLTLNK,SDC,SDT)) Q:'SDT D
99 ...S SDY=0 F S SDY=$O(^SC("AWAS",CNSLTLNK,SDC,SDT,SDY)) Q:'SDY D
100 ....;don't process if already exists (install rerun).
101 ....Q:$D(^SC("AWAS1",CNSLTLNK,SDC,SDT,SDY))
102 ....;create Class I CONSULT LINK field and xrefs.
103 ....S DA(2)=SDC,DA(1)=SDT,DA=SDY
104 ....S DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,",DR="688////^S X=CNSLTLNK"
105 ....D ^DIE
106 . S $P(^XTMP("SD53P478",1),U)=CNSLTLNK
107 S $P(^XTMP("SD53P478",1),U,2)="DONE"
108 ;move Class 3 'AHST' Consult history to new 'AHST1' xref.
109 D MES^XPDUTL(" ....Restoring historical cross reference entries.")
110 M ^SC("AHST1")=^SC("AHST")
111 D BMES^XPDUTL("Class III Conversion Complete.")
112 K SDSEED
113 D BMES^XPDUTL("*****")
114 ;
115NOTIFY ;Send notification
116 N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
117 I '$G(GMRSTOP),'$G(SDSTOP),($P($G(^XTMP("GMRC3P52",1)),U,2)="DONE"),($P($G(^XTMP("SD53P478",1)),U,2)="DONE") D
118 . S XMDUZ="APPOINTMENT/CONSULT LINK"
119 . S XMSUB="Class 3 Consults Conversion Complete"
120 . S XMTEXT="^TMP(""GMRC3P52"",$J,"
121 . S XMY(DUZ)=""
122 . S ^TMP("GMRC3P52",$J,1)=" "
123 . S ^TMP("GMRC3P52",$J,2)="The conversion of your ASSOCIATED STOP CODES and CONSULT LINK Class III entries"
124 . S ^TMP("GMRC3P52",$J,3)="to the new Class I fields in patch SD*5.3*478 has successfully completed."
125 . S ^TMP("GMRC3P52",$J,4)=" "
126 . S ^TMP("GMRC3P52",$J,5)="After completely satified with you conversion, please follow the instructions"
127 . S ^TMP("GMRC3P52",$J,6)="in the Patch Installation Guide for removing your Class III fields."
128 . D ^XMD K ^TMP("GMRC3P52",$J),XMY
129 Q
Note: See TracBrowser for help on using the repository browser.