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

PXRMP19I.m

Go to the documentation of this file.
  1. PXRMP19I ; BP/AGP/WAT - PXRM*2.0*19 INSTALL ROUTINE. ;02/27/17 13:27
  1. ;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187
  1. Q
  1. ;2053 UPDATE^DIE | 3217 $$FIND1^DIC | 2056 $$GET1^DIQ | 10103 $$FMADD^XLFDT| 10067 DES^XMA21 | 5249 ^TIU(8925.1
  1. ;5247 ^GMT(142 | 10141 ^XPDUTL | 4440 PROD^XUPROD | 2541 KSP^XUPARAM | 1131 ^XMB("NETNAME") | 10067 DES^XMA21 | 2172 XPDID
  1. ;
  1. PRE ;
  1. N INC
  1. I $D(^XTMP("PXRM CCHT_HT")) S INC=(+$O(^XTMP("PXRM CCHT_HT",1000000000),-1)+1)
  1. E S INC=1
  1. S ^XTMP("PXRM CCHT_HT",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^"_"CONTAINS ANY ITEMS RENAMED BY PXRM*2.0*19"
  1. N P47I
  1. S P47I=$$PATCH^XPDUTL("PXRM*2.0*47")
  1. I 'P47I D
  1. . D OPTION^PXRMUTIL("DISABLE")
  1. . D PROTOCOL^PXRMUTIL("DISABLE")
  1. I P47I D
  1. . D OPTIONS^PXRMUTIL("DISABLE","INSTALL OF PXRM*2.0*19")
  1. . D PROTCOLS^PXRMUTIL("DISABLE","INSTALL OF PXRM*2.0*19")
  1. D HFACTOR^PXRMP19B
  1. D EDTOPICS
  1. D INSTUB
  1. D DELEXE^PXRMEXSI("EXARRAY","PXRMP19E")
  1. Q
  1. ;
  1. POST ;
  1. K:$D(^XTMP("PXRM19RECIPS")) ^XTMP("PXRM19RECIPS")
  1. N XPDIDTOT,PXRMNUM,PXRMPOST,OUTPUT
  1. N XMDUZ,XMDF,XMMG,X,XMOUT,XMY,DIR,NXT
  1. S XPDIDTOT=6,PXRMNUM=1,PXRMPOST=1
  1. S OUTPUT(1)="The post-install will generate a single MailMan message:"
  1. S OUTPUT(2)="LOCAL CCHT HFs NOT USED IN NAT'L HT CLIN REMINDER CONTENT"
  1. S OUTPUT(3)="The installer is strongly encouraged to include the site's local Clinical"
  1. S OUTPUT(4)="Reminders support/configuration personnel/mail group as recipients."
  1. ;Enable options and protocols
  1. N P47I
  1. S P47I=$$PATCH^XPDUTL("PXRM*2.0*47")
  1. I 'P47I D
  1. . D OPTION^PXRMUTIL("ENABLE")
  1. . D PROTOCOL^PXRMUTIL("ENABLE")
  1. I P47I D
  1. . D OPTIONS^PXRMUTIL("ENABLE","INSTALL OF PXRM*2.0*19")
  1. . D PROTCOLS^PXRMUTIL("ENABLE","INSTALL OF PXRM*2.0*19")
  1. D BMES^XPDUTL("Preparing to install Reminder Exchange entry VA-HT PROJECT.")
  1. D MES^XPDUTL("This is a very large entry that installs numerous components.")
  1. D MES^XPDUTL("Installation of this entry will take 10-15 minutes.")
  1. D SMEXINS^PXRMEXSI("EXARRAY","PXRMP19E")
  1. D UPDATE
  1. D BMES^XPDUTL(.OUTPUT)
  1. S XMDUZ=DUZ
  1. D DES^XMA21
  1. I $D(XMY)>9 D
  1. .S ^XTMP("PXRM19RECIPS",0)=$$FMADD^XLFDT(DT,31)_U_DT_U_"RECIPIENTS OF PXRM*2.0*19 POST INSTALL MESSAGES"
  1. .M ^XTMP("PXRM19RECIPS")=XMY
  1. D QUEUE^PXRMP19A("post-install message","MAIN^PXRMP19A","PXRM*2.0*19 HT MAILMAM REPORT",.PXRMNUM)
  1. D ORWPCE^PXRMP19A(.PXRMNUM)
  1. D TIURMDLG^PXRMP19A(.PXRMNUM)
  1. D SETTIU
  1. D SENDIM
  1. Q
  1. ;
  1. UPDATE ;update progress bar during post-install
  1. I $G(PXRMPOST)=1 D UPDATE^XPDID(PXRMNUM) S PXRMNUM=PXRMNUM+1
  1. Q
  1. ;
  1. SETTIU ;set tiu obj class owner
  1. ;;HT CAREGIVER
  1. ;;HT CATEGORY OF CARE
  1. ;;HT EMERGENCY PRIORITY RATING
  1. ;;HT ENROLLMENT START DATE
  1. ;;HT MED RECON
  1. ;;HT NIC/CCM RATING LAST
  1. ;;HT REMINDERS DUE
  1. ;;ADMISSIONS PAST YR
  1. ;;GEC BASIC ADLS (LAST)
  1. ;;GEC IADLS (LAST)
  1. ;;OUTPT APPTS PAST YR
  1. ;;NEXT OF KIN
  1. ;;EOF
  1. D MES^XPDUTL("Setting Data Fields for TIU-HS Objects")
  1. N FDA,FDAIEN,ERRMSG,MSG,OBJIEN,HSI,HSTYPE,NAME,OWNER,PXRMERR
  1. S HSI=""
  1. S OWNER=$$LU(8930,"CLINICAL COORDINATOR")
  1. S FDAIEN="?1"
  1. F HSI=1:1 S HSTYPE=$P($T(SETTIU+HSI),";",3) Q:HSTYPE="EOF" D
  1. .N FDA
  1. .S NAME=$P($T(SETTIU+HSI),";;",2)
  1. .S OBJIEN=$$LU(8925.1,NAME)
  1. .I $G(OBJIEN)=0 D BMES^XPDUTL(NAME_" not found in TIU DOCUMENT DEFINITION file") Q
  1. .I $G(OBJIEN)="" S ERRMSG="Error during lookup. The error returned was:" D ERR(ERRMSG,.PXRMERR) Q
  1. .Q:$P(^TIU(8925.1,$G(OBJIEN),0),U,4)'="O"
  1. .S FDA(8925.1,OBJIEN_",",.06)=$G(OWNER)
  1. .S FDA(8925.1,OBJIEN_",",.13)="YES"
  1. .S FDA(8925.1,OBJIEN_",",99)=$H
  1. .D UPDATE^DIE("","FDA","","MSG")
  1. .I $D(MSG("DIERR")) S ERRMSG="Error setting data..." D ERR(ERRMSG,.MSG) Q
  1. D BMES^XPDUTL("Setting Data Fields Complete")
  1. D UPDATE
  1. Q
  1. ;
  1. ERR(ERRMSG,MSG) ; error
  1. I $D(MSG) D Q
  1. .D BMES^XPDUTL($G(ERRMSG))
  1. .S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
  1. Q
  1. ;
  1. LU(FILE,NAME) ; DBS lookup
  1. Q $$FIND1^DIC(FILE,"","X",NAME,,,"PXRMERR")
  1. ;
  1. SENDIM ;Send install message.
  1. N FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
  1. S NODE="PXRM*2.0*19"
  1. K ^TMP(NODE,$J)
  1. S FROM="PXRM*2.0*19 Install@"_^XMB("NETNAME")
  1. S SYSTEM=$$KSP^XUPARAM("WHERE")
  1. I $$PROD^XUPROD(1) S TO("G.CLINICAL REMINDERS SUPPORT@DOMAIN.EXT")=""
  1. E D
  1. . N MGIEN,MGROUP
  1. . S MGIEN=$G(^PXRM(800,1,"MGFE"))
  1. . S MGROUP=$S(MGIEN'="":"G."_$$GET1^DIQ(3.8,MGIEN,.01),1:DUZ)
  1. . S TO(MGROUP)=""
  1. S SUBJECT="Install of PXRM*2.0*19"
  1. S ^TMP(NODE,$J,1,0)="PXRM*2.0*19 has been installed."
  1. S ^TMP(NODE,$J,2,0)="System is "_SYSTEM
  1. D SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
  1. D UPDATE
  1. Q
  1. ;
  1. EDTOPICS ;
  1. ;if low IEN at pilot site; rename to VA- to avoid two entries at low IENs with different names
  1. N LIST,PXNAT,PXRMINST,FILENUM,NAME,DA,MSG,NEWNAME
  1. D EDLIST(.LIST)
  1. S PXNAT=1
  1. S FILENUM="" F S FILENUM=$O(LIST(FILENUM)) Q:FILENUM="" D
  1. .S NAME="" F S NAME=$O(LIST(FILENUM,NAME)) Q:NAME="" D
  1. ..S DA=$$FIND1^DIC(FILENUM,"","BX",NAME,"","","MSG") Q:DA=0 ;don't proceed if item not found.
  1. ..I $D(MSG("DIERR")) D Q
  1. ...D BMES^XPDUTL("Error during lookup of "_NAME)
  1. ...S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
  1. ..Q:DA'<100000 ;if the IEN is high/local, leave entry as is and pilot site will have to manually delete/repoint to new VA- nat'l entry
  1. ..I NAME="CARE COORDINATION HOME TELEHEALTH (CCHT)" S NEWNAME="VA-HOME TELEHEALTH (HT)" D RENAME^PXRMUTIL(FILENUM,NAME,NEWNAME) Q
  1. ..S NEWNAME="VA-"_NAME D RENAME^PXRMUTIL(FILENUM,NAME,NEWNAME)
  1. ..S ^XTMP("PXRM CCHT_HT",INC,0)=FILENUM_"^"_NAME_"^"_NEWNAME,INC=INC+1
  1. Q
  1. ;
  1. EDLIST(LIST) ;list of ed topics
  1. S LIST(9999999.09,"CARE COORDINATION HOME TELEHEALTH (CCHT)")=""
  1. S LIST(9999999.09,"HOME TELEHEALTH-DISEASE MGMT/PATIENT SELF-MGMT")=""
  1. S LIST(9999999.09,"HOME TELEHEALTH-IN HOME MONITORING")=""
  1. S LIST(9999999.09,"HOME TELEHEALTH-CAREGIVER EDUCATION/SUPPORT")=""
  1. S LIST(9999999.09,"HOME TELEHEALTH-MEDICATION MANAGEMENT")=""
  1. Q
  1. ;
  1. INSTUB ;stubs for non-remote types
  1. ;;VA-ADMISSIONS PAST YR
  1. ;;VA-GEC IADLS
  1. ;;VA-GEC BASIC ADLS
  1. ;;VA-HT BASIC ADLS
  1. ;;VA-HT CAREGIVER
  1. ;;VA-HT CATEGORY OF CARE LAST
  1. ;;VA-HT EMERGENCY LEVELS LAST
  1. ;;VA-HT ENROLLMENT START
  1. ;;VA-HT IADLS
  1. ;;VA-HT MED RECON
  1. ;;VA-HT NIC/CCM RATING LAST
  1. ;;VA-HT REMINDERS DUE
  1. ;;VA-NEXT OF KIN
  1. ;;VA-OUTPT APPTS PAST YR
  1. ;;EOF
  1. N DA,DIE,DR,IEN,LIEN,NAME
  1. N HSTYPE,HSI
  1. N FDA,MSG,HSIEN
  1. S HSI=""
  1. S DIE="^GMT(142,"
  1. F HSI=1:1 S HSTYPE=$P($T(INSTUB+HSI),";",3) Q:HSTYPE="EOF" D
  1. .;if type already exists, quit out for this type
  1. .Q:$D(^GMT(142,"B",HSTYPE))>0
  1. .S IEN=0 F S IEN=$O(^GMT(142,IEN)) D Q:IEN'>0!(IEN=5000001)
  1. ..I IEN<5000000 S LIEN=IEN
  1. .I LIEN<5000000 D
  1. ..S DA=LIEN
  1. ..Q:DA=5000000
  1. ..S DA=DA+1
  1. ..I '$D(^GMT(142,DA)) D
  1. ...S FDA(1,142,"+1,",.01)=HSTYPE
  1. ...S HSIEN(1)=DA
  1. ...D UPDATE^DIE("S","FDA(1)","HSIEN","MSG")
  1. Q
  1. ;