Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCYP57

GMRCYP57.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;This patch creates a new entry into the Request Services file, #123.5.
  1.  ;This new entry supports the entering of IFCs originating from the VA's Suicide Prevention Hotline
  1.  ;External References
  1.  ;$$LKUP^XUAF4(): Institution Lookup, ICR # 2171
  1.  ;BMES^XPDUTL(): Output a Message, ICR# 10141
  1.  ;^DIC
  1.  ;MIX^DIC1
  1.  ;UPDATE^DIE
  1.  ;^DIK
  1.  ;SVC^GMRC101H
  1.  ;MSG^XQOR
  1.  ;****LOCAL VARIABLES****
  1.  ;FDA - FileMan Data Array
  1.  ;GMRCERR - array to hold any errors returned by UPDATE^DIE
  1.  ;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
  1.  N FDA,GMRC,ERR,GMRCIEN,STAIEN,ERRMSG
  1.  S ERRMSG(1)="INSTALL ABORTED - NO CHANGES WERE MADE TO YOUR SYSTEM."
  1.  S ERRMSG(2)="COULD NOT FIND ""UPSTATE NEW YORK HCS"" IN INSTITUTION FILE"
  1.  S ERRMSG(3)="CONFIRM FILE ENTRY AND RE-INSTALL"
  1.  S ERRMSG(4)="IF STILL UNSUCCESSFUL, CONTACT VA NAT'L HELP DESK OR SUBMIT REMEDY TICKET"
  1.  ;MGH COMMENTED OUT
  1.  ;S STAIEN=$$LKUP^XUAF4(528) ;return IEN from INSTITUTION file for this station number
  1.  ;I 'STAIEN D BMES^XPDUTL(ERRMSG)
  1.  ;Q:'STAIEN
  1.  D ADDENTRY
  1.  D AD2ALSVC
  1.  D ORDUPDT
  1.  Q
  1. ADDENTRY ; add new service to 123.5
  1.  S FDA(1,123.5,"+1,",.01)="SUICIDE HOTLINE"
  1.  ;MGH COMMENTED OUT
  1.  ;S FDA(1,123.5134,"+2,+1,",.01)=STAIEN
  1.  S FDA(1,123.5,"+1,",2)="2"
  1.  D UPDATE^DIE("","FDA(1)","GMRCIEN","GMRCERR($J)")
  1.  Q
  1. AD2ALSVC ;add new service as sub-serivce of All Services
  1.  S FDA(2,123.5,"?1,",.01)="ALL SERVICES"
  1.  S FDA(2,123.51,"+4,?1,",.01)=$P(GMRCIEN(1),U,1)
  1.  D UPDATE^DIE("","FDA(2)","GMRCIEN","GMRCERR($J)")
  1.  Q
  1. ORDUPDT ;update orderable items file with new service entry
  1.  ;GMRCSRVC - ien of new service, GMRCSSNM - name of new service
  1.  N DIC,GMRCMSG,GMRCSRVC,GMRCSSNM,GMRCACT
  1.  S DIC="^GMR(123.5,",DIC(0)="B",X="SUICIDE HOTLINE" D ^DIC Q:Y=-1
  1.  S GMRCSRVC=$P(Y,U)
  1.  S GMRCSSNM=$P(Y,U,2)
  1.  S GMRCACT="MUP"
  1.  D SVC^GMRC101H(GMRCSRVC,GMRCSSNM,GMRCACT),MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
  1.  K X,Y
  1.  Q
  1. PRE ;clean up and old entries of SUICIDE CONSULTS from previous test versions
  1.  N DIC,DIK,DA,SVCIEN,SBSVCIEN,SVCIENSH
  1.  ;SVCIEN - IEN of "ALL SERVICES"
  1.  ;SBSVCIEN - IEN corresponding to SUICIDE HOTLINE entry in SUBSERVICE of ALL SERVICES
  1.  ;SVCIENSH - IEN of 'SUICIDE HOTLINE"
  1.  S DIC="^GMR(123.5,",DIC(0)="B",X="ALL SERVICES" D ^DIC
  1.  Q:Y=-1  S SVCIEN=$P(Y,U) K X,Y
  1.  ;now i have IEN for all services
  1.  S DIC="^GMR(123.5,1,10,",DIC(0)="",D="AC",X="SUICIDE HOTLINE" D MIX^DIC1
  1.  ;1st piece is subservice ien, 2nd piece is top leve ien for suicide hotline
  1.  Q:Y=-1
  1.  S SBSVCIEN=$P(Y,U),SVCIENSH=$P(Y,U,2) K X,Y,D
  1.  ;now i have ien for suicide subservice and ien for suicide top level entry
  1.  ;remove suicide as a subservice of all services
  1.  S DIK="^GMR(123.5,"_SVCIEN_",10,",DA=SBSVCIEN,DA(1)=SVCIEN D ^DIK
  1.  Q:Y=-1
  1.  N GMRCMSG,GMRCSRVC,GMRCSSNM,GMRCACT
  1.  S DIC="^GMR(123.5,",DIC(0)="B",X="SUICIDE HOTLINE" D ^DIC Q:Y=-1
  1.  S GMRCSRVC=$P(Y,U)
  1.  S GMRCSSNM=$P(Y,U,2)
  1.  S GMRCACT="MDC"
  1.  D SVC^GMRC101H(GMRCSRVC,GMRCSSNM,GMRCACT),MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
  1.  ;remove suicide from 123.5
  1.  S DIK="^GMR(123.5,",DA=SVCIENSH D ^DIK
  1.  K X,Y
  1.  Q