GMRCYP57 ;BP/WAT - POST INSTALL FOR GMRC*3*57 ;JUL 24, 2007 0830
;;3.0;CONSULT/REQUEST TRACKING;**57**;DEC 27, 1997;Build 10
;
;This patch creates a new entry into the Request Services file, #123.5.
;This new entry supports the entering of IFCs originating from the VA's Suicide Prevention Hotline
;External References
;$$LKUP^XUAF4(): Institution Lookup, ICR # 2171
;BMES^XPDUTL(): Output a Message, ICR# 10141
;^DIC
;MIX^DIC1
;UPDATE^DIE
;^DIK
;SVC^GMRC101H
;MSG^XQOR
;****LOCAL VARIABLES****
;FDA - FileMan Data Array
;GMRCERR - array to hold any errors returned by UPDATE^DIE
;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
N FDA,GMRC,ERR,GMRCIEN,STAIEN,ERRMSG
S ERRMSG(1)="INSTALL ABORTED - NO CHANGES WERE MADE TO YOUR SYSTEM."
S ERRMSG(2)="COULD NOT FIND ""UPSTATE NEW YORK HCS"" IN INSTITUTION FILE"
S ERRMSG(3)="CONFIRM FILE ENTRY AND RE-INSTALL"
S ERRMSG(4)="IF STILL UNSUCCESSFUL, CONTACT VA NAT'L HELP DESK OR SUBMIT REMEDY TICKET"
S STAIEN=$$LKUP^XUAF4(528) ;return IEN from INSTITUTION file for this station number
I 'STAIEN D BMES^XPDUTL(ERRMSG)
Q:'STAIEN
D ADDENTRY
D AD2ALSVC
D ORDUPDT
Q
ADDENTRY ; add new service to 123.5
S FDA(1,123.5,"+1,",.01)="SUICIDE HOTLINE"
S FDA(1,123.5134,"+2,+1,",.01)=STAIEN
S FDA(1,123.5,"+1,",2)="2"
D UPDATE^DIE("","FDA(1)","GMRCIEN","GMRCERR($J)")
Q
AD2ALSVC ;add new service as sub-serivce of All Services
S FDA(2,123.5,"?1,",.01)="ALL SERVICES"
S FDA(2,123.51,"+4,?1,",.01)=$P(GMRCIEN(1),U,1)
D UPDATE^DIE("","FDA(2)","GMRCIEN","GMRCERR($J)")
Q
ORDUPDT ;update orderable items file with new service entry
;GMRCSRVC - ien of new service, GMRCSSNM - name of new service
N DIC,GMRCMSG,GMRCSRVC,GMRCSSNM,GMRCACT
S DIC="^GMR(123.5,",DIC(0)="B",X="SUICIDE HOTLINE" D ^DIC Q:Y=-1
S GMRCSRVC=$P(Y,U)
S GMRCSSNM=$P(Y,U,2)
S GMRCACT="MUP"
D SVC^GMRC101H(GMRCSRVC,GMRCSSNM,GMRCACT),MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
K X,Y
Q
PRE ;clean up and old entries of SUICIDE CONSULTS from previous test versions
N DIC,DIK,DA,SVCIEN,SBSVCIEN,SVCIENSH
;SVCIEN - IEN of "ALL SERVICES"
;SBSVCIEN - IEN corresponding to SUICIDE HOTLINE entry in SUBSERVICE of ALL SERVICES
;SVCIENSH - IEN of 'SUICIDE HOTLINE"
S DIC="^GMR(123.5,",DIC(0)="B",X="ALL SERVICES" D ^DIC
Q:Y=-1 S SVCIEN=$P(Y,U) K X,Y
;now i have IEN for all services
S DIC="^GMR(123.5,1,10,",DIC(0)="",D="AC",X="SUICIDE HOTLINE" D MIX^DIC1
;1st piece is subservice ien, 2nd piece is top leve ien for suicide hotline
Q:Y=-1
S SBSVCIEN=$P(Y,U),SVCIENSH=$P(Y,U,2) K X,Y,D
;now i have ien for suicide subservice and ien for suicide top level entry
;remove suicide as a subservice of all services
S DIK="^GMR(123.5,"_SVCIEN_",10,",DA=SBSVCIEN,DA(1)=SVCIEN D ^DIK
Q:Y=-1
N GMRCMSG,GMRCSRVC,GMRCSSNM,GMRCACT
S DIC="^GMR(123.5,",DIC(0)="B",X="SUICIDE HOTLINE" D ^DIC Q:Y=-1
S GMRCSRVC=$P(Y,U)
S GMRCSSNM=$P(Y,U,2)
S GMRCACT="MDC"
D SVC^GMRC101H(GMRCSRVC,GMRCSSNM,GMRCACT),MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
;remove suicide from 123.5
S DIK="^GMR(123.5,",DA=SVCIENSH D ^DIK
K X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCYP57 3256 printed Dec 13, 2024@01:47:59 Page 2
GMRCYP57 ;BP/WAT - POST INSTALL FOR GMRC*3*57 ;JUL 24, 2007 0830
+1 ;;3.0;CONSULT/REQUEST TRACKING;**57**;DEC 27, 1997;Build 10
+2 ;
+3 ;This patch creates a new entry into the Request Services file, #123.5.
+4 ;This new entry supports the entering of IFCs originating from the VA's Suicide Prevention Hotline
+5 ;External References
+6 ;$$LKUP^XUAF4(): Institution Lookup, ICR # 2171
+7 ;BMES^XPDUTL(): Output a Message, ICR# 10141
+8 ;^DIC
+9 ;MIX^DIC1
+10 ;UPDATE^DIE
+11 ;^DIK
+12 ;SVC^GMRC101H
+13 ;MSG^XQOR
+14 ;****LOCAL VARIABLES****
+15 ;FDA - FileMan Data Array
+16 ;GMRCERR - array to hold any errors returned by UPDATE^DIE
+17 ;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
+18 NEW FDA,GMRC,ERR,GMRCIEN,STAIEN,ERRMSG
+19 SET ERRMSG(1)="INSTALL ABORTED - NO CHANGES WERE MADE TO YOUR SYSTEM."
+20 SET ERRMSG(2)="COULD NOT FIND ""UPSTATE NEW YORK HCS"" IN INSTITUTION FILE"
+21 SET ERRMSG(3)="CONFIRM FILE ENTRY AND RE-INSTALL"
+22 SET ERRMSG(4)="IF STILL UNSUCCESSFUL, CONTACT VA NAT'L HELP DESK OR SUBMIT REMEDY TICKET"
+23 ;return IEN from INSTITUTION file for this station number
SET STAIEN=$$LKUP^XUAF4(528)
+24 IF 'STAIEN
DO BMES^XPDUTL(ERRMSG)
+25 if 'STAIEN
QUIT
+26 DO ADDENTRY
+27 DO AD2ALSVC
+28 DO ORDUPDT
+29 QUIT
ADDENTRY ; add new service to 123.5
+1 SET FDA(1,123.5,"+1,",.01)="SUICIDE HOTLINE"
+2 SET FDA(1,123.5134,"+2,+1,",.01)=STAIEN
+3 SET FDA(1,123.5,"+1,",2)="2"
+4 DO UPDATE^DIE("","FDA(1)","GMRCIEN","GMRCERR($J)")
+5 QUIT
AD2ALSVC ;add new service as sub-serivce of All Services
+1 SET FDA(2,123.5,"?1,",.01)="ALL SERVICES"
+2 SET FDA(2,123.51,"+4,?1,",.01)=$PIECE(GMRCIEN(1),U,1)
+3 DO UPDATE^DIE("","FDA(2)","GMRCIEN","GMRCERR($J)")
+4 QUIT
ORDUPDT ;update orderable items file with new service entry
+1 ;GMRCSRVC - ien of new service, GMRCSSNM - name of new service
+2 NEW DIC,GMRCMSG,GMRCSRVC,GMRCSSNM,GMRCACT
+3 SET DIC="^GMR(123.5,"
SET DIC(0)="B"
SET X="SUICIDE HOTLINE"
DO ^DIC
if Y=-1
QUIT
+4 SET GMRCSRVC=$PIECE(Y,U)
+5 SET GMRCSSNM=$PIECE(Y,U,2)
+6 SET GMRCACT="MUP"
+7 DO SVC^GMRC101H(GMRCSRVC,GMRCSSNM,GMRCACT)
DO MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
+8 KILL X,Y
+9 QUIT
PRE ;clean up and old entries of SUICIDE CONSULTS from previous test versions
+1 NEW DIC,DIK,DA,SVCIEN,SBSVCIEN,SVCIENSH
+2 ;SVCIEN - IEN of "ALL SERVICES"
+3 ;SBSVCIEN - IEN corresponding to SUICIDE HOTLINE entry in SUBSERVICE of ALL SERVICES
+4 ;SVCIENSH - IEN of 'SUICIDE HOTLINE"
+5 SET DIC="^GMR(123.5,"
SET DIC(0)="B"
SET X="ALL SERVICES"
DO ^DIC
+6 if Y=-1
QUIT
SET SVCIEN=$PIECE(Y,U)
KILL X,Y
+7 ;now i have IEN for all services
+8 SET DIC="^GMR(123.5,1,10,"
SET DIC(0)=""
SET D="AC"
SET X="SUICIDE HOTLINE"
DO MIX^DIC1
+9 ;1st piece is subservice ien, 2nd piece is top leve ien for suicide hotline
+10 if Y=-1
QUIT
+11 SET SBSVCIEN=$PIECE(Y,U)
SET SVCIENSH=$PIECE(Y,U,2)
KILL X,Y,D
+12 ;now i have ien for suicide subservice and ien for suicide top level entry
+13 ;remove suicide as a subservice of all services
+14 SET DIK="^GMR(123.5,"_SVCIEN_",10,"
SET DA=SBSVCIEN
SET DA(1)=SVCIEN
DO ^DIK
+15 if Y=-1
QUIT
+16 NEW GMRCMSG,GMRCSRVC,GMRCSSNM,GMRCACT
+17 SET DIC="^GMR(123.5,"
SET DIC(0)="B"
SET X="SUICIDE HOTLINE"
DO ^DIC
if Y=-1
QUIT
+18 SET GMRCSRVC=$PIECE(Y,U)
+19 SET GMRCSSNM=$PIECE(Y,U,2)
+20 SET GMRCACT="MDC"
+21 DO SVC^GMRC101H(GMRCSRVC,GMRCSSNM,GMRCACT)
DO MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
+22 ;remove suicide from 123.5
+23 SET DIK="^GMR(123.5,"
SET DA=SVCIENSH
DO ^DIK
+24 KILL X,Y
+25 QUIT
