source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCYP57.m@ 1361

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

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1GMRCYP57 ;BP/WAT - POST INSTALL FOR GMRC*3*57 ;10:07 AM 1 Jan 2008
2 ;;3.0;CONSULT/REQUEST TRACKING;**57**;DEC 27, 1997;Build 10
3 ;
4 ;This patch creates a new entry into the Request Services file, #123.5.
5 ;This new entry supports the entering of IFCs originating from the VA's Suicide Prevention Hotline
6 ;External References
7 ;$$LKUP^XUAF4(): Institution Lookup, ICR # 2171
8 ;BMES^XPDUTL(): Output a Message, ICR# 10141
9 ;^DIC
10 ;MIX^DIC1
11 ;UPDATE^DIE
12 ;^DIK
13 ;SVC^GMRC101H
14 ;MSG^XQOR
15 ;****LOCAL VARIABLES****
16 ;FDA - FileMan Data Array
17 ;GMRCERR - array to hold any errors returned by UPDATE^DIE
18 ;GMRCIEN - Internal Entry Number Array - used to return the IEN of the newly added service and pass that IEN to the second UPDATE^DIE call as part of the FDA(2) array
19 N FDA,GMRC,ERR,GMRCIEN,STAIEN,ERRMSG
20 S ERRMSG(1)="INSTALL ABORTED - NO CHANGES WERE MADE TO YOUR SYSTEM."
21 S ERRMSG(2)="COULD NOT FIND ""UPSTATE NEW YORK HCS"" IN INSTITUTION FILE"
22 S ERRMSG(3)="CONFIRM FILE ENTRY AND RE-INSTALL"
23 S ERRMSG(4)="IF STILL UNSUCCESSFUL, CONTACT VA NAT'L HELP DESK OR SUBMIT REMEDY TICKET"
24 S STAIEN=$$LKUP^XUAF4(528)
25 I 'STAIEN D BMES^XPDUTL(ERRMSG)
26 Q:'STAIEN
27 D ADDENTRY
28 D AD2ALSVC
29 D ORDUPDT
30 Q
31ADDENTRY ; add new service to 123.5
32 S FDA(1,123.5,"+1,",.01)="SUICIDE HOTLINE"
33 S FDA(1,123.5134,"+2,+1,",.01)=STAIEN
34 S FDA(1,123.5,"+1,",2)="2"
35 D UPDATE^DIE("","FDA(1)","GMRCIEN","GMRCERR($J)")
36 Q
37AD2ALSVC ;add new service as sub-serivce of All Services
38 S FDA(2,123.5,"?1,",.01)="ALL SERVICES"
39 S FDA(2,123.51,"+4,?1,",.01)=$P(GMRCIEN(1),U,1)
40 D UPDATE^DIE("","FDA(2)","GMRCIEN","GMRCERR($J)")
41 Q
42ORDUPDT ;update orderable items file with new service entry
43 ;GMRCSRVC - ien of new service, GMRCSSNM - name of new service
44 N DIC,GMRCMSG,GMRCSRVC,GMRCSSNM,GMRCACT
45 S DIC="^GMR(123.5,",DIC(0)="B",X="SUICIDE HOTLINE" D ^DIC Q:Y=-1
46 S GMRCSRVC=$P(Y,U)
47 S GMRCSSNM=$P(Y,U,2)
48 S GMRCACT="MUP"
49 D SVC^GMRC101H(GMRCSRVC,GMRCSSNM,GMRCACT),MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
50 K X,Y
51 Q
52PRE ;clean up and old entries of SUICIDE CONSULTS from previous test versions
53 N DIC,DIK,DA,SVCIEN,SBSVCIEN,SVCIENSH
54 ;SVCIEN - IEN of "ALL SERVICES"
55 ;SBSVCIEN - IEN corresponding to SUICIDE HOTLINE entry in SUBSERVICE of ALL SERVICES
56 ;SVCIENSH - IEN of 'SUICIDE HOTLINE"
57 S DIC="^GMR(123.5,",DIC(0)="B",X="ALL SERVICES" D ^DIC
58 Q:Y=-1 S SVCIEN=$P(Y,U) K X,Y
59 ;now i have IEN for all services
60 S DIC="^GMR(123.5,1,10,",DIC(0)="",D="AC",X="SUICIDE HOTLINE" D MIX^DIC1
61 ;1st piece is subservice ien, 2nd piece is top leve ien for suicide hotline
62 Q:Y=-1
63 S SBSVCIEN=$P(Y,U),SVCIENSH=$P(Y,U,2) K X,Y,D
64 ;now i have ien for suicide subservice and ien for suicide top level entry
65 ;remove suicide as a subservice of all services
66 S DIK="^GMR(123.5,"_SVCIEN_",10,",DA=SBSVCIEN,DA(1)=SVCIEN D ^DIK
67 Q:Y=-1
68 N GMRCMSG,GMRCSRVC,GMRCSSNM,GMRCACT
69 S DIC="^GMR(123.5,",DIC(0)="B",X="SUICIDE HOTLINE" D ^DIC Q:Y=-1
70 S GMRCSRVC=$P(Y,U)
71 S GMRCSSNM=$P(Y,U,2)
72 S GMRCACT="MDC"
73 D SVC^GMRC101H(GMRCSRVC,GMRCSSNM,GMRCACT),MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
74 ;remove suicide from 123.5
75 S DIK="^GMR(123.5,",DA=SVCIENSH D ^DIK
76 K X,Y
77 Q
Note: See TracBrowser for help on using the repository browser.