AG72ENMP ;IHS/SD/TPF - Patient Registration 7.2 MPI ENVIRONMENT CHECKER ;
;;7.2;IHS PATIENT REGISTRATION;**1**;JAN 07, 2011
;
I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
S X=$P(^VA(200,DUZ,0),U)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
W !!,$$CJ^XLFSTR("Checking Environment for RPMS MPI CLIENT Software",IOM),!
N AGQUIT
S AGQUIT=0
I '$$PATCH("XU*8.0*1015") W !,$$CJ^XLFSTR("Need at least Kernel patch 1015....patch 1015 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
E W !,$$CJ^XLFSTR("Need at least Kernel patch 1015....patch 1015 Present",IOM)
;
I '$$PATCH("AVA*93.2*20") W !,$$CJ^XLFSTR("Need at least AVA patch 20....patch 20 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
E W !,$$CJ^XLFSTR("Need at least AVA patch 20....patch 20 Present",IOM)
;
I '$$PATCH("AG*7.1*9") W !,$$CJ^XLFSTR("Need at least AG patch 9....patch 9 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
E W !,$$CJ^XLFSTR("Need at least AG patch 9....patch 9 Present",IOM)
;NOT KNOWN WHEN THIS WILL GO OUT
;I '$$PATCH("PIMS*5.3*1013") W !,$$CJ^XLFSTR("Need at least PIMS patch 1013....patch 1013 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
;E W !,$$CJ^XLFSTR("Need at least PIMS 5.3 patch 1013....patch 1013 Present",IOM)
;
I $$VERSION^XPDUTL("BPM")'="1.0" W !,$$CJ^XLFSTR("Need at least IHS PATIENT MERGE V 1.0.... V 1.0 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
E W !,$$CJ^XLFSTR("Need at least IHS PATIENT MERGE V 1.0.... V 1.0 Present",IOM)
;
S X=$$LAST^XPDUTL("IHS DICTIONARIES (PATIENT)","99.1")
I $P(X,U)<20 W !,$$CJ^XLFSTR("AUPN v99.1 Patch 20 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
E W !,$$CJ^XLFSTR("AUPN v99.1 Patch 20 INSTALLED",IOM)
;
S X=$$LAST^XPDUTL("IHS PATIENT REGISTRATION","7.1")
I $P(X,U)<8 W !,$$CJ^XLFSTR("V7.1 PATCH 8 NOT INSTALLED AG 7.2 WILL NOT INSTALL",IOM) S AGQUIT=2 D SORRY(2)
;
S X=$$LAST^XPDUTL("HEALTH LEVEL SEVEN","1.6")
I '$D(^XPD(9.7,"B","HL*1.6*1006")) D
.W !,$$CJ^XLFSTR("HEALTH LEVEL SEVEN V1.6 PATCH 1006 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
;
I '$$VCHK("AUT","98.1",2) D
.W !,$$CJ^XLFSTR("AUT V98.1 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
;
S X=$$LAST^XPDUTL("IHS DICTIONARIES (POINTERS)","98.1")
I $P(X,U)<20 W !,$$CJ^XLFSTR("AUT v98.1 Patch 20 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
;
I '$$VCHK("DI","22.0",2) S AGQUIT=2
;
I '$$PATCH("HL*1.6*1006") D SORRY(2) W !,$$CJ^XLFSTR("Need at least HL V1.6 patch 1006....patch 1006 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2) Q
E W !,$$CJ^XLFSTR("Need at least HL V1.6 patch 1006....patch 1006 Present",IOM)
;
I AGQUIT Q
;
NEW DA,DIC
S X="AG",DIC="^DIC(9.4,",DIC(0)="",D="C"
D IX^DIC
I Y<0,$D(^DIC(9.4,"C","AG")) D S AGQUIT=2
. W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AG"" prefix.",IOM)
. W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
. W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
I $G(XPDENV)=1 D
. S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
. D OPTSAV("AGMENU")
;
S STATNUM=$$CHKSTAT(DUZ(2)) ;CHECK FOR STATION NUMBER
I STATNUM="" D
.W $$CJ^XLFSTR("THERE MUST BE A STATION NUMBER TO SEND MPI HL7 MESSAGES",IOM)
.W $$CJ^XLFSTR("IF YOU DON'T HAVE ONE, ONE CAN BE ASSIGNED TO YOU BY THE DBA",IOM)
.W $$CJ^XLFSTR("PLEASE CONTACT THE DBA FOR THE PROPER STATION NUMBER FOR YOUR SITE.",IOM)
.S AGQUIT=1
E D
.W !!,$$CJ^XLFSTR("THE FOLLOWING STATION NUMBER WAS FOUND IN THE",IOM)
.W $$CJ^XLFSTR("INSTITUTION FILE: "_STATNUM,IOM)
.W !,$$CJ^XLFSTR("PLEASE CONFIRM WITH THE OIT RPMS DBA THIS IS THE CORRECT",IOM)
.W !,$$CJ^XLFSTR("STATION NUMBER FOR '"_$P(^DIC(4,DUZ(2),0),U)_"' FACILITY?",IOM)
.W !
.K DIR
.S DIR(0)="Y"
.D ^DIR
.Q:Y
.W !!,$$CJ^XLFSTR("PLEASE ENTER THE CORRECT STATION NUMBER",IOM)
.K DIR,DIE,DIC,DA,DR
.S DIE="^DIC(4,"
.S DIE("NO^")=""
.S DR="99R"
.S DA=DUZ(2)
.D ^DIE
S STATNUM=$$CHKSTAT(DUZ(2)) ;CHECK FOR STATION NUMBER
I 'STATNUM D
.S AGQUIT=1
.W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("THE MPI PATCH NEEDS STATION NUMBER IN THE INSTITUTION FILE",IOM)
.W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("THE STATION NUMBER MUST BE ONE ASSIGNED BY THE OIT DBA",IOM)
;
I AGQUIT D SORRY(AGQUIT) Q
;
W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
;
I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
Q
SORRY(X) ;
KILL DIFQ
S XPDQUIT=X
W:'$D(ZTQUEUED) *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
Q
VCHK(AGPRE,AGVER,AGQUIT) ;Check versions needed.
NEW AGV
S AGV=$$VERSION^XPDUTL(AGPRE)
W !,$$CJ^XLFSTR("Need at least "_AGPRE_" v "_AGVER_"....."_AGPRE_" v "_AGV_" Present",IOM)
I AGV<AGVER W *7,!,$$CJ^XLFSTR("^^^^**NEED TO UPGRADE**^^^^",IOM) Q 0
Q 1
OPTSAV(AGM) ;
D BMES^XPDUTL("Saving the configuration of option '"_AGM_"'...")
I $D(^XTMP("AG71",7.2,"OPTSAV",AGM)) D BMES^XPDUTL("NOT SAVED. Option '"_AGM_"' has previously been saved.") Q
I '$D(^XTMP("AG71")) S ^XTMP("AG71",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"AG71 - SAVE OPTION CONFIGURATIONS."
NEW I,A
S I=$O(^DIC(19,"B",AGM,0))
I 'I D BMES^XPDUTL("NOT SAVED. Option '"_AGM_"' not found in OPTION file.") Q
S A=0
F S A=$O(^DIC(19,I,10,A)) Q:'A S ^XTMP("AG71",7.2,"OPTSAV",AGM,A)=$P(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$P(^DIC(19,I,10,A,0),U,2,3)
Q
INSTALLD(AGINSTAL) ;EP
NEW DIC,X,Y
S X=$P(AGINSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",22,",X=$P(AGINSTAL,"*",2)
D ^DIC
I Y<1 Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(AGINSTAL,"*",3)
D ^DIC
Q $S(Y<1:0,1:1)
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
N %,I,J
S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
;check if patch is just a number
Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
S %=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
Q (X=+%)
;
CHKSTAT(DUZ2) ;EP - GET STATION NUMBER
N STATNUM
S STATNUM=$$GET1^DIQ(4,DUZ2_",",99,"E")
Q STATNUM
;
PRE ;EP - PRE INSTALL
D ADDHLOAP ;ADD 'RPMS-MPI' TO HLO APPLICATION REGISTRY
Q
POST ;EP - POST INSTALL ACTIONS
D CHKSYS ;CHECK 779.1 FOR IP, HLO STANDARD LISTENER
D ADDLOGLK ;ADD MPI LOGICAL LINKS
D CHKTASK ;CHECK 779.3 FOR DEDICATED LINK, ACTIVE
D SUBSCRIB ;SUBSCRIBE TO PIMS PROTOCOLS
D ADDMENU ;ADD MPI MENU TO AGMENU
D VERUPD ;UPDATE THE BUILD'S PACKAGE VERSION
Q
;
SUBSCRIB ;EP - SUBSCRIBE TO PIMS PROTOCOLS
K DIE,DIR,DIC,DA,DR
S DIC="^ORD(101,"
S DIC(0)="EQM"
S X="BDGPM MOVEMENT EVENTS"
D ^DIC
I Y<0 D Q
.W !,$$CJ^XLFSTR("'BDGPM MOVEMENT EVENTS' MISSING FROM SYSTEM",IOM)
.W !,$$CJ^XLFSTR("THIS IS NEEDED FOR ADMISSION OR DISCHARGE EVENTS",IOM)
.W !,$$CJ^XLFSTR("TO TRIGGER AN A01/A03 MESSAGE",IOM)
.W !,$$CJ^XLFSTR("PLEASE INFORM THE HELP DESK",IOM)
.W !,$$CJ^XLFSTR("BOTH PIMS AND MPI SUPPORT SHOULD BE NOTIFIED!",IOM)
S DA(1)=+Y
S DIC="^ORD(101,"_DA(1)_",10," ;^ORD(101,D0,10,D1,0)= (#.01) ITEM [1P:101
S DIC(0)="L"
S X="AGMP MPI ADMIT DISCHARGE"
D ^DIC
I Y<0 D
.W !,$$CJ^XLFSTR("'AGMP MPI ADMIT DISCHARGE' COULD NOT BE ADDED AS AN ITEM",IOM)
.W !,$$CJ^XLFSTR("TO THE 'BDGPM MOVEMENT EVENTS' PROTOCOL",IOM)
.W !,$$CJ^XLFSTR("SEE TECHNICAL MANUAL FOR MANUAL ENTRY",IOM)
K DIE,DIR,DIC,DR
S DA=+Y
S DIE="^ORD(101,"_DA(1)_",10,"
S DR="3///^S X=140"
D ^DIE
K DIE,DIR,DIC,DA,DR
S DIC="^ORD(101,"
S DIC(0)="EQM"
S X="BSDAM APPOINTMENT EVENTS"
D ^DIC
I Y<0 D Q
.W !,$$CJ^XLFSTR("'BSDAM APPOINTMENT EVENTS' MISSING FROM SYSTEM",IOM)
.W !,$$CJ^XLFSTR("THIS IS NEEDED FOR CHECK-IN OR CHECK-OUT EVENTS",IOM)
.W !,$$CJ^XLFSTR("TO TRIGGER AN A01/A03 MESSAGE",IOM)
.W !,$$CJ^XLFSTR("PLEASE INFORM THE HELP DESK",IOM)
.W !,$$CJ^XLFSTR("BOTH PIMS AND MPI SUPPORT SHOULD BE NOTIFIED!",IOM)
S DA(1)=+Y
S DIC="^ORD(101,"_DA(1)_",10,"
S DIC(0)="L"
S X="AGMP MPI CHECKIN CHECKOUT"
D ^DIC
I Y<0 D
.W !,$$CJ^XLFSTR("'AGMP MPI CHECKIN CHECKOUT' COULD NOT BE ADDED",IOM)
.W !,$$CJ^XLFSTR("TO THE 'BSDAM APPOINTMENT EVENTS' PROTOCOL",IOM)
.W !,$$CJ^XLFSTR("SEE TECH MANUAL FOR ENTRY",IOM)
K DIE,DIR,DIC,DR
S DA=+Y
S DIE="^ORD(101,"_DA(1)_",10,"
S DR="3///^S X=40"
D ^DIE
K DIE,DIR,DIC,DA,DR
Q
;
CHKTASK ;EP - CHECK 779.3 SETTINGS
N ACTIVE,LINK,IENS
K DIE,DIC,DA,DR,DIR
S DIC="^HLD(779.3,"
S DIC(0)="EMQ"
S X="TASKMAN MULTI-LISTENER"
D ^DIC
I Y<0 D Q
.W !!,$$CJ^XLFSTR("'TASKMAN MULTI-LISTENER' NOT FOUND CALL HELP DESK",IOM)
S IENS=+Y
S ACTIVE=$$GET1^DIQ(779.3,IENS_",",.02,"I") ;ACTIVE
I 'ACTIVE D
.K DIE,DIC,DA,DR,DIR
.S DIE="^HLD(779.3,"
.S DA=IENS
.S DR=".02////1"
.D ^DIE
S LINK=$$GET1^DIQ(779.3,IENS_",",.14,"E") ;DEDICATED LINK
Q:LINK="HLO RPMS"
K DIE,DIC,DA,DR,DIR
S DIE="^HLD(779.3,"
S DA=IENS
S LINK="HLO RPMS"
S DR=".14////^S X=LINK"
D ^DIE
Q
;
CHKSYS ;EP - CHECK 779.1 SETTINGS
ASKIP ;-EP - ASK FOR IP
N IP,LISTNR,PROD,STATNUM,MAXSTR,BUFHL7,BUFFUSE,MSGRET,BADRET
K DIR
S DIR("A")="ENTER THIS SERVER'S IP ADDRESS"
S DIR(0)="F"
D ^DIR
I Y'?1.3N1"."1.3N1"."1.3N1"."1.3N D G ASKIP
.W !!,"PLEASE ENTER THIS SERVER'S IP ADDRESS!"
S IP=Y
S DIE="^HLD(779.1,"
S DA=1
S DR=".01///^S X=IP"
D ^DIE
;
S LISTNR=$$GET1^DIQ(779.1,1_",",.1,"E") ;HLO STANDARD LISTENER
I LISTNR="" D
.S DIE="^HLD(779.1,"
.S DA=1
.S LISTNR="HLO RPMS"
.S DR=".1///^S X=LISTNR"
.D ^DIE
;
S STATNUM=$$GET1^DIQ(779.1,1_",",.02,"E") ;STATION NUMBER IN 779.1
S INSTSTA=$$GET1^DIQ(779.1,DUZ(2)_",",99,"E") ;STATION NUMBER FROM INSTITUTION FILE
I STATNUM'=INSTSTA D Q:'STATNUM
.S STATNUM=$$CHKSTAT(DUZ(2))
.I 'STATNUM D Q
..W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("STATION NUMBER NOT FOUND IN INSTITUTION FILE",IOM)
..W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("INFORM HELP DESK!",IOM)
.S DIE="^HLD(779.1,"
.S DA=1
.S DR=".02////^S X=STATNUM"
.D ^DIE
Q:'$G(STATNUM)
S PROD=$$GET1^DIQ(779.1,1_",",.03,"I")
I PROD'="P" D
.S PROD="P"
.S DA=1
.S DR=".03///^S X=PROD"
.D ^DIE
S MAXSTR=$$GET1^DIQ(779.1,1_",",.04,"I")
I MAXSTR'=512 D
.S MAXSTR=512
.S DA=1
.S DR=".04///^S X=MAXSTR"
.D ^DIE
S BUFHL7=$$GET1^DIQ(779.1,1_",",.05,"I")
I BUFHL7'=15000 D
.S BUFHL7=15000
.S DA=1
.S DR=".05///^S X=BUFHL7"
.D ^DIE
S BUFUSE=$$GET1^DIQ(779.1,1_",",.06,"I")
I BUFUSE'=5000 D
.S BUFUSE=5000
.S DA=1
.S DR=".06///^S X=BUFUSE"
.D ^DIE
S MSGRET=$$GET1^DIQ(779.1,1_",",.07,"I")
I MSGRET'=36 D
.S MSGRET=36
.S DA=1
.S DR=".07///^S X=MSGRET"
.D ^DIE
S BADRET=$$GET1^DIQ(779.1,1_",",.08,"I")
I BADRET'=7 D
.S BADRET=7
.S DA=1
.S DR=".08///^S X=BADRET"
.D ^DIE
K DIE,DIC,DA,DR,DIR
Q
;
ADDLOGLK ;EP - ADD OR EDIT 'HL LOGICAL LINK'
K DIE,DIC,DA,DIR,DR
S DIC="^HLCS(870,"
S DIC(0)="LX"
S X="MPI"
D ^DIC
I Y<1 D
.W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("'MPI' NOT ADDED TO HL LOGICAL LINK FILE",IOM)
.W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("SEE PATCH NOTES AND ADD MANUALLY",IOM)
D LINKMPI(+Y)
D ADDPORT ;ADD PORT NUMBER TO REG. PAR. 2203
Q
;
ADDPORT ;EP - ADD PORT
W !!,"ENTER THE SAME MPI LISTENER PORT ENTERED IN THE ENSEMBLE PRODUCTION."
W !,"IF YOU ARE A MULTI-NAMESPACE SITE, YOU MUST ENTER A UNIQUE LISTENER"
W !,"PORT FOR EACH NAMESPACE YOU INSTALL AGMPI IN ON THIS SERVER."
K DIR
S DIR(0)="N^5201:5299"
S DIR("A")="ENTER MPI LISTENER PORT FOR THIS NAMESPACE"
S DIR("B")="5201"
D ^DIR
S TCPPORT=Y
S FAC=0
F S FAC=$O(^AGFAC(FAC)) Q:'FAC D
. I $P($G(^AGFAC(FAC,0)),"^",21)'="Y" Q
. K DIE,DIR,DA,DR,DIC
. S DIE="^AGFAC("
. S DR="2203///^S X=TCPPORT"
. S DA=FAC
. D ^DIE
Q
;
LINKMPI(DA) ;EP - DO EDIT
S DIE="^HLCS(870,"
S DEVTYP="Persistent Client"
S SHUTLLP="NO"
S LLPTYP="TCP"
S AUTSTART="Enabled"
S QUESIZE="10"
S TCPIP="10.154.33.14"
S TCPPORT="5200"
S TCPTYPE="CLIENT (SENDER)"
S PERS="NO"
;
S DR="2///^S X=LLPTYP"
S DR=DR_";3///^S X=DEVTYP"
S DR=DR_";4.5///^S X=AUTSTART"
S DR=DR_";14///^S X=SHUTLLP"
S DR=DR_";21///^S X=QUESIZE"
S DR=DR_";400.01///^S X=TCPIP"
S DR=DR_";400.03///^S X=TCPTYPE"
S DR=DR_";400.08///^S X=TCPPORT"
S DR=DR_";400.04///^S X=PERS"
D ^DIE
K DIR,DIE,DIC,DR,DA
Q
;
LINKHLO(DA) ;EP - DO EDIT
;NOT USED BECASUE EDR STOLE 5026
S DIE="^HLCS(870,"
S SHUTLLP="YES"
S LLPTYP="TCP"
S QUESIZE="10"
S TCPIP="127.0.0.1"
S TCPPORT="5026"
;
ASKPORT ;EP - ASK PORT
I $P($G(^HLD(779.1,1,0)),U)="161.223.93.44" D G:$D(DTOUT)!(DUOUT)!(DTOUT)!(X="") ASKPORT
.W !!,"YOU ARE A CALIFORNIA MULTI NAMESPACE SITE"
.W !,"YOU MUST ENTER A UNIQUE LISTENER PORT FOR"
.W !,"EACH NAMESPACE YOU INSTALL AGMPI IN"
.K DIR
.S DIR(0)="N"
.S DIR("A")="ENTER HLO LISTENER PORT ASSIGNED TO YOU"
.D ^DIR
.S TCPPORT=Y
;
S DR="2///^S X=LLPTYP"
S DR=DR_";14///^S X=SHUTLLP"
S DR=DR_";21///^S X=QUESIZE"
S DR=DR_";400.01///^S X=TCPIP"
S DR=DR_";400.03///^S X=TCPTYPE"
S DR=DR_";400.08///^S X=TCPPORT"
D ^DIE
K DIR,DIE,DIC,DR,DA
Q
;
ADDHLOAP ;EP - ADD 'RPMS-MPI' RECEIVING APP TO HLO APPLICATION REGISTRY
K DIE,DIC,DA,DIR,DR
S DIC="^HLD(779.2,"
S DIC(0)="L"
S X="RPMS-MPI"
D ^DIC
I Y<0 D Q
.W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("HLO APPLICATION "_X_" COULD NOT BE ADDED",IOM)
.W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("TO FILE 779.2",IOM)
.W:'$D(ZTQUEUED) !!,$$CJ^XLFSTR("PLEASE ADD MANUALLY. USE PATCH NOTES",IOM)
S RECORD=+Y
K DIE,DIC,DA,DIR,DR
S DIE="^HLD(779.2,"
S DA=RECORD
S PRVTQUE="MPI RPMS"
S ACTTAG="ERR"
S ACTRTN="AGMPIHLO"
S PKGLINK="HEALTH LEVEL SEVEN"
S DR=".03///^S X=PRVTQUE"
S DR=DR_";.06///^S X=ACTTAG"
S DR=DR_";.07///^S X=ACTRTN"
S DR=DR_";2///^S X=PKGLINK"
D ^DIE
K DIE,DIC,DIR,DR,DA
Q
;
N RET
S RET=$$ADD^XPDMENU("AGMENU","AGMP HLO MPI MANAGER OPTIONS","MPI",13)
D BMES^XPDUTL($$CJ^XLFSTR("MPI Manager Options [AGMP HLO MPI MANAGER OPTIONS] option",80))
D BMES^XPDUTL($$CJ^XLFSTR("was"_$S(RET:"",1:" NOT")_" added to the Patient registration Menu [AGMENU] ",80))
Q
VERUPD ;UPDATE THE PACKAGE VERSION NUMBER
;GRAB THE BUILD'S VERSION NUMBER
S BVER=$$VER^XPDUTL(XPDNM),PKG=$$PKG^XPDUTL(XPDNM)
;SEE WHAT THE INSTALLED VERSION IS
S IVER=$$VERSION^XPDUTL(PKG)
;IF THE INSTALLED VERSION LESS THAN THE BUILD'S VERSION, THEN SET THE PACKAGE'S
;CURRENT VERSION TO THE BUILD'S VERSION
I IVER<BVER D Q:$D(XPDABORT)
. S PKGIEN=$O(^DIC(9.4,"C",PKG,0)) S:PKGIEN'>0 PKGIEN=$O(^DIC(9.4,"B",PKG,0))
. I 'PKGIEN S XPDABORT=1 D BMES^XPDUTL("Unable to update package version. Contact OIT for support.") Q
. D PKGVER^XPDIP(PKGIEN,BVER)
Q
AG72ENMP ;IHS/SD/TPF - Patient Registration 7.2 MPI ENVIRONMENT CHECKER ;
+1 ;;7.2;IHS PATIENT REGISTRATION;**1**;JAN 07, 2011
+2 ;
+3 IF '$GET(DUZ)
WRITE !,"DUZ UNDEFINED OR 0."
DO SORRY(2)
QUIT
+4 IF '$LENGTH($GET(DUZ(0)))
WRITE !,"DUZ(0) UNDEFINED OR NULL."
DO SORRY(2)
QUIT
+5 SET X=$PIECE(^VA(200,DUZ,0),U)
+6 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+7 WRITE !!,$$CJ^XLFSTR("Checking Environment for RPMS MPI CLIENT Software",IOM),!
+8 NEW AGQUIT
+9 SET AGQUIT=0
+10 IF '$$PATCH("XU*8.0*1015")
WRITE !,$$CJ^XLFSTR("Need at least Kernel patch 1015....patch 1015 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
+11 IF '$TEST
WRITE !,$$CJ^XLFSTR("Need at least Kernel patch 1015....patch 1015 Present",IOM)
+12 ;
+13 IF '$$PATCH("AVA*93.2*20")
WRITE !,$$CJ^XLFSTR("Need at least AVA patch 20....patch 20 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
+14 IF '$TEST
WRITE !,$$CJ^XLFSTR("Need at least AVA patch 20....patch 20 Present",IOM)
+15 ;
+16 IF '$$PATCH("AG*7.1*9")
WRITE !,$$CJ^XLFSTR("Need at least AG patch 9....patch 9 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
+17 IF '$TEST
WRITE !,$$CJ^XLFSTR("Need at least AG patch 9....patch 9 Present",IOM)
+18 ;NOT KNOWN WHEN THIS WILL GO OUT
+19 ;I '$$PATCH("PIMS*5.3*1013") W !,$$CJ^XLFSTR("Need at least PIMS patch 1013....patch 1013 NOT INSTALLED",IOM) S AGQUIT=2 D SORRY(2)
+20 ;E W !,$$CJ^XLFSTR("Need at least PIMS 5.3 patch 1013....patch 1013 Present",IOM)
+21 ;
+22 IF $$VERSION^XPDUTL("BPM")'="1.0"
WRITE !,$$CJ^XLFSTR("Need at least IHS PATIENT MERGE V 1.0.... V 1.0 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
+23 IF '$TEST
WRITE !,$$CJ^XLFSTR("Need at least IHS PATIENT MERGE V 1.0.... V 1.0 Present",IOM)
+24 ;
+25 SET X=$$LAST^XPDUTL("IHS DICTIONARIES (PATIENT)","99.1")
+26 IF $PIECE(X,U)<20
WRITE !,$$CJ^XLFSTR("AUPN v99.1 Patch 20 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
+27 IF '$TEST
WRITE !,$$CJ^XLFSTR("AUPN v99.1 Patch 20 INSTALLED",IOM)
+28 ;
+29 SET X=$$LAST^XPDUTL("IHS PATIENT REGISTRATION","7.1")
+30 IF $PIECE(X,U)<8
WRITE !,$$CJ^XLFSTR("V7.1 PATCH 8 NOT INSTALLED AG 7.2 WILL NOT INSTALL",IOM)
SET AGQUIT=2
DO SORRY(2)
+31 ;
+32 SET X=$$LAST^XPDUTL("HEALTH LEVEL SEVEN","1.6")
+33 IF '$DATA(^XPD(9.7,"B","HL*1.6*1006"))
Begin DoDot:1
+34 WRITE !,$$CJ^XLFSTR("HEALTH LEVEL SEVEN V1.6 PATCH 1006 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
End DoDot:1
+35 ;
+36 IF '$$VCHK("AUT","98.1",2)
Begin DoDot:1
+37 WRITE !,$$CJ^XLFSTR("AUT V98.1 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
End DoDot:1
+38 ;
+39 SET X=$$LAST^XPDUTL("IHS DICTIONARIES (POINTERS)","98.1")
+40 IF $PIECE(X,U)<20
WRITE !,$$CJ^XLFSTR("AUT v98.1 Patch 20 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
+41 ;
+42 IF '$$VCHK("DI","22.0",2)
SET AGQUIT=2
+43 ;
+44 IF '$$PATCH("HL*1.6*1006")
DO SORRY(2)
WRITE !,$$CJ^XLFSTR("Need at least HL V1.6 patch 1006....patch 1006 NOT INSTALLED",IOM)
SET AGQUIT=2
DO SORRY(2)
QUIT
+45 IF '$TEST
WRITE !,$$CJ^XLFSTR("Need at least HL V1.6 patch 1006....patch 1006 Present",IOM)
+46 ;
+47 IF AGQUIT
QUIT
+48 ;
+49 NEW DA,DIC
+50 SET X="AG"
SET DIC="^DIC(9.4,"
SET DIC(0)=""
SET D="C"
+51 DO IX^DIC
+52 IF Y<0
IF $DATA(^DIC(9.4,"C","AG"))
Begin DoDot:1
+53 WRITE !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AG"" prefix.",IOM)
+54 WRITE !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
+55 WRITE !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7
End DoDot:1
SET AGQUIT=2
+56 IF $GET(XPDENV)=1
Begin DoDot:1
+57 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+58 DO OPTSAV("AGMENU")
End DoDot:1
+59 ;
+60 ;CHECK FOR STATION NUMBER
SET STATNUM=$$CHKSTAT(DUZ(2))
+61 IF STATNUM=""
Begin DoDot:1
+62 WRITE $$CJ^XLFSTR("THERE MUST BE A STATION NUMBER TO SEND MPI HL7 MESSAGES",IOM)
+63 WRITE $$CJ^XLFSTR("IF YOU DON'T HAVE ONE, ONE CAN BE ASSIGNED TO YOU BY THE DBA",IOM)
+64 WRITE $$CJ^XLFSTR("PLEASE CONTACT THE DBA FOR THE PROPER STATION NUMBER FOR YOUR SITE.",IOM)
+65 SET AGQUIT=1
End DoDot:1
+66 IF '$TEST
Begin DoDot:1
+67 WRITE !!,$$CJ^XLFSTR("THE FOLLOWING STATION NUMBER WAS FOUND IN THE",IOM)
+68 WRITE $$CJ^XLFSTR("INSTITUTION FILE: "_STATNUM,IOM)
+69 WRITE !,$$CJ^XLFSTR("PLEASE CONFIRM WITH THE OIT RPMS DBA THIS IS THE CORRECT",IOM)
+70 WRITE !,$$CJ^XLFSTR("STATION NUMBER FOR '"_$PIECE(^DIC(4,DUZ(2),0),U)_"' FACILITY?",IOM)
+71 WRITE !
+72 KILL DIR
+73 SET DIR(0)="Y"
+74 DO ^DIR
+75 IF Y
QUIT
+76 WRITE !!,$$CJ^XLFSTR("PLEASE ENTER THE CORRECT STATION NUMBER",IOM)
+77 KILL DIR,DIE,DIC,DA,DR
+78 SET DIE="^DIC(4,"
+79 SET DIE("NO^")=""
+80 SET DR="99R"
+81 SET DA=DUZ(2)
+82 DO ^DIE
End DoDot:1
+83 ;CHECK FOR STATION NUMBER
SET STATNUM=$$CHKSTAT(DUZ(2))
+84 IF 'STATNUM
Begin DoDot:1
+85 SET AGQUIT=1
+86 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("THE MPI PATCH NEEDS STATION NUMBER IN THE INSTITUTION FILE",IOM)
+87 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("THE STATION NUMBER MUST BE ONE ASSIGNED BY THE OIT DBA",IOM)
End DoDot:1
+88 ;
+89 IF AGQUIT
DO SORRY(AGQUIT)
QUIT
+90 ;
+91 WRITE !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
+92 ;
+93 IF '$$DIR^XBDIR("E","","","","","",1)
DO SORRY(2)
QUIT
+94 QUIT
SORRY(X) ;
+1 KILL DIFQ
+2 SET XPDQUIT=X
+3 IF '$DATA(ZTQUEUED)
WRITE *7,!,$$CJ^XLFSTR("Sorry....",IOM),$$DIR^XBDIR("E","Press RETURN")
+4 QUIT
VCHK(AGPRE,AGVER,AGQUIT) ;Check versions needed.
+1 NEW AGV
+2 SET AGV=$$VERSION^XPDUTL(AGPRE)
+3 WRITE !,$$CJ^XLFSTR("Need at least "_AGPRE_" v "_AGVER_"....."_AGPRE_" v "_AGV_" Present",IOM)
+4 IF AGV<AGVER
WRITE *7,!,$$CJ^XLFSTR("^^^^**NEED TO UPGRADE**^^^^",IOM)
QUIT 0
+5 QUIT 1
OPTSAV(AGM) ;
+1 DO BMES^XPDUTL("Saving the configuration of option '"_AGM_"'...")
+2 IF $DATA(^XTMP("AG71",7.2,"OPTSAV",AGM))
DO BMES^XPDUTL("NOT SAVED. Option '"_AGM_"' has previously been saved.")
QUIT
+3 IF '$DATA(^XTMP("AG71"))
SET ^XTMP("AG71",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"AG71 - SAVE OPTION CONFIGURATIONS."
+4 NEW I,A
+5 SET I=$ORDER(^DIC(19,"B",AGM,0))
+6 IF 'I
DO BMES^XPDUTL("NOT SAVED. Option '"_AGM_"' not found in OPTION file.")
QUIT
+7 SET A=0
+8 FOR
SET A=$ORDER(^DIC(19,I,10,A))
IF 'A
QUIT
SET ^XTMP("AG71",7.2,"OPTSAV",AGM,A)=$PIECE(^DIC(19,+^DIC(19,I,10,A,0),0),U,1)_U_$PIECE(^DIC(19,I,10,A,0),U,2,3)
+9 QUIT
INSTALLD(AGINSTAL) ;EP
+1 NEW DIC,X,Y
+2 SET X=$PIECE(AGINSTAL,"*",1)
+3 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+4 DO IX^DIC
+5 IF Y<1
QUIT 0
+6 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(AGINSTAL,"*",2)
+7 DO ^DIC
+8 IF Y<1
QUIT 0
+9 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(AGINSTAL,"*",3)
+10 DO ^DIC
+11 QUIT $SELECT(Y<1:0,1:1)
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
+1 IF X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N
QUIT 0
+2 NEW %,I,J
+3 SET I=$ORDER(^DIC(9.4,"C",$PIECE(X,"*"),0))
IF 'I
QUIT 0
+4 SET J=$ORDER(^DIC(9.4,I,22,"B",$PIECE(X,"*",2),0))
SET X=$PIECE(X,"*",3)
IF 'J
QUIT 0
+5 ;check if patch is just a number
+6 IF $ORDER(^DIC(9.4,I,22,J,"PAH","B",X,0))
QUIT 1
+7 SET %=$ORDER(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
+8 QUIT (X=+%)
+9 ;
CHKSTAT(DUZ2) ;EP - GET STATION NUMBER
+1 NEW STATNUM
+2 SET STATNUM=$$GET1^DIQ(4,DUZ2_",",99,"E")
+3 QUIT STATNUM
+4 ;
PRE ;EP - PRE INSTALL
+1 ;ADD 'RPMS-MPI' TO HLO APPLICATION REGISTRY
DO ADDHLOAP
+2 QUIT
POST ;EP - POST INSTALL ACTIONS
+1 ;CHECK 779.1 FOR IP, HLO STANDARD LISTENER
DO CHKSYS
+2 ;ADD MPI LOGICAL LINKS
DO ADDLOGLK
+3 ;CHECK 779.3 FOR DEDICATED LINK, ACTIVE
DO CHKTASK
+4 ;SUBSCRIBE TO PIMS PROTOCOLS
DO SUBSCRIB
+5 ;ADD MPI MENU TO AGMENU
DO ADDMENU
+6 ;UPDATE THE BUILD'S PACKAGE VERSION
DO VERUPD
+7 QUIT
+8 ;
SUBSCRIB ;EP - SUBSCRIBE TO PIMS PROTOCOLS
+1 KILL DIE,DIR,DIC,DA,DR
+2 SET DIC="^ORD(101,"
+3 SET DIC(0)="EQM"
+4 SET X="BDGPM MOVEMENT EVENTS"
+5 DO ^DIC
+6 IF Y<0
Begin DoDot:1
+7 WRITE !,$$CJ^XLFSTR("'BDGPM MOVEMENT EVENTS' MISSING FROM SYSTEM",IOM)
+8 WRITE !,$$CJ^XLFSTR("THIS IS NEEDED FOR ADMISSION OR DISCHARGE EVENTS",IOM)
+9 WRITE !,$$CJ^XLFSTR("TO TRIGGER AN A01/A03 MESSAGE",IOM)
+10 WRITE !,$$CJ^XLFSTR("PLEASE INFORM THE HELP DESK",IOM)
+11 WRITE !,$$CJ^XLFSTR("BOTH PIMS AND MPI SUPPORT SHOULD BE NOTIFIED!",IOM)
End DoDot:1
QUIT
+12 SET DA(1)=+Y
+13 ;^ORD(101,D0,10,D1,0)= (#.01) ITEM [1P:101
SET DIC="^ORD(101,"_DA(1)_",10,"
+14 SET DIC(0)="L"
+15 SET X="AGMP MPI ADMIT DISCHARGE"
+16 DO ^DIC
+17 IF Y<0
Begin DoDot:1
+18 WRITE !,$$CJ^XLFSTR("'AGMP MPI ADMIT DISCHARGE' COULD NOT BE ADDED AS AN ITEM",IOM)
+19 WRITE !,$$CJ^XLFSTR("TO THE 'BDGPM MOVEMENT EVENTS' PROTOCOL",IOM)
+20 WRITE !,$$CJ^XLFSTR("SEE TECHNICAL MANUAL FOR MANUAL ENTRY",IOM)
End DoDot:1
+21 KILL DIE,DIR,DIC,DR
+22 SET DA=+Y
+23 SET DIE="^ORD(101,"_DA(1)_",10,"
+24 SET DR="3///^S X=140"
+25 DO ^DIE
+26 KILL DIE,DIR,DIC,DA,DR
+27 SET DIC="^ORD(101,"
+28 SET DIC(0)="EQM"
+29 SET X="BSDAM APPOINTMENT EVENTS"
+30 DO ^DIC
+31 IF Y<0
Begin DoDot:1
+32 WRITE !,$$CJ^XLFSTR("'BSDAM APPOINTMENT EVENTS' MISSING FROM SYSTEM",IOM)
+33 WRITE !,$$CJ^XLFSTR("THIS IS NEEDED FOR CHECK-IN OR CHECK-OUT EVENTS",IOM)
+34 WRITE !,$$CJ^XLFSTR("TO TRIGGER AN A01/A03 MESSAGE",IOM)
+35 WRITE !,$$CJ^XLFSTR("PLEASE INFORM THE HELP DESK",IOM)
+36 WRITE !,$$CJ^XLFSTR("BOTH PIMS AND MPI SUPPORT SHOULD BE NOTIFIED!",IOM)
End DoDot:1
QUIT
+37 SET DA(1)=+Y
+38 SET DIC="^ORD(101,"_DA(1)_",10,"
+39 SET DIC(0)="L"
+40 SET X="AGMP MPI CHECKIN CHECKOUT"
+41 DO ^DIC
+42 IF Y<0
Begin DoDot:1
+43 WRITE !,$$CJ^XLFSTR("'AGMP MPI CHECKIN CHECKOUT' COULD NOT BE ADDED",IOM)
+44 WRITE !,$$CJ^XLFSTR("TO THE 'BSDAM APPOINTMENT EVENTS' PROTOCOL",IOM)
+45 WRITE !,$$CJ^XLFSTR("SEE TECH MANUAL FOR ENTRY",IOM)
End DoDot:1
+46 KILL DIE,DIR,DIC,DR
+47 SET DA=+Y
+48 SET DIE="^ORD(101,"_DA(1)_",10,"
+49 SET DR="3///^S X=40"
+50 DO ^DIE
+51 KILL DIE,DIR,DIC,DA,DR
+52 QUIT
+53 ;
CHKTASK ;EP - CHECK 779.3 SETTINGS
+1 NEW ACTIVE,LINK,IENS
+2 KILL DIE,DIC,DA,DR,DIR
+3 SET DIC="^HLD(779.3,"
+4 SET DIC(0)="EMQ"
+5 SET X="TASKMAN MULTI-LISTENER"
+6 DO ^DIC
+7 IF Y<0
Begin DoDot:1
+8 WRITE !!,$$CJ^XLFSTR("'TASKMAN MULTI-LISTENER' NOT FOUND CALL HELP DESK",IOM)
End DoDot:1
QUIT
+9 SET IENS=+Y
+10 ;ACTIVE
SET ACTIVE=$$GET1^DIQ(779.3,IENS_",",.02,"I")
+11 IF 'ACTIVE
Begin DoDot:1
+12 KILL DIE,DIC,DA,DR,DIR
+13 SET DIE="^HLD(779.3,"
+14 SET DA=IENS
+15 SET DR=".02////1"
+16 DO ^DIE
End DoDot:1
+17 ;DEDICATED LINK
SET LINK=$$GET1^DIQ(779.3,IENS_",",.14,"E")
+18 IF LINK="HLO RPMS"
QUIT
+19 KILL DIE,DIC,DA,DR,DIR
+20 SET DIE="^HLD(779.3,"
+21 SET DA=IENS
+22 SET LINK="HLO RPMS"
+23 SET DR=".14////^S X=LINK"
+24 DO ^DIE
+25 QUIT
+26 ;
CHKSYS ;EP - CHECK 779.1 SETTINGS
ASKIP ;-EP - ASK FOR IP
+1 NEW IP,LISTNR,PROD,STATNUM,MAXSTR,BUFHL7,BUFFUSE,MSGRET,BADRET
+2 KILL DIR
+3 SET DIR("A")="ENTER THIS SERVER'S IP ADDRESS"
+4 SET DIR(0)="F"
+5 DO ^DIR
+6 IF Y'?1.3N1"."1.3N1"."1.3N1"."1.3N
Begin DoDot:1
+7 WRITE !!,"PLEASE ENTER THIS SERVER'S IP ADDRESS!"
End DoDot:1
GOTO ASKIP
+8 SET IP=Y
+9 SET DIE="^HLD(779.1,"
+10 SET DA=1
+11 SET DR=".01///^S X=IP"
+12 DO ^DIE
+13 ;
+14 ;HLO STANDARD LISTENER
SET LISTNR=$$GET1^DIQ(779.1,1_",",.1,"E")
+15 IF LISTNR=""
Begin DoDot:1
+16 SET DIE="^HLD(779.1,"
+17 SET DA=1
+18 SET LISTNR="HLO RPMS"
+19 SET DR=".1///^S X=LISTNR"
+20 DO ^DIE
End DoDot:1
+21 ;
+22 ;STATION NUMBER IN 779.1
SET STATNUM=$$GET1^DIQ(779.1,1_",",.02,"E")
+23 ;STATION NUMBER FROM INSTITUTION FILE
SET INSTSTA=$$GET1^DIQ(779.1,DUZ(2)_",",99,"E")
+24 IF STATNUM'=INSTSTA
Begin DoDot:1
+25 SET STATNUM=$$CHKSTAT(DUZ(2))
+26 IF 'STATNUM
Begin DoDot:2
+27 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("STATION NUMBER NOT FOUND IN INSTITUTION FILE",IOM)
+28 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("INFORM HELP DESK!",IOM)
End DoDot:2
QUIT
+29 SET DIE="^HLD(779.1,"
+30 SET DA=1
+31 SET DR=".02////^S X=STATNUM"
+32 DO ^DIE
End DoDot:1
IF 'STATNUM
QUIT
+33 IF '$GET(STATNUM)
QUIT
+34 SET PROD=$$GET1^DIQ(779.1,1_",",.03,"I")
+35 IF PROD'="P"
Begin DoDot:1
+36 SET PROD="P"
+37 SET DA=1
+38 SET DR=".03///^S X=PROD"
+39 DO ^DIE
End DoDot:1
+40 SET MAXSTR=$$GET1^DIQ(779.1,1_",",.04,"I")
+41 IF MAXSTR'=512
Begin DoDot:1
+42 SET MAXSTR=512
+43 SET DA=1
+44 SET DR=".04///^S X=MAXSTR"
+45 DO ^DIE
End DoDot:1
+46 SET BUFHL7=$$GET1^DIQ(779.1,1_",",.05,"I")
+47 IF BUFHL7'=15000
Begin DoDot:1
+48 SET BUFHL7=15000
+49 SET DA=1
+50 SET DR=".05///^S X=BUFHL7"
+51 DO ^DIE
End DoDot:1
+52 SET BUFUSE=$$GET1^DIQ(779.1,1_",",.06,"I")
+53 IF BUFUSE'=5000
Begin DoDot:1
+54 SET BUFUSE=5000
+55 SET DA=1
+56 SET DR=".06///^S X=BUFUSE"
+57 DO ^DIE
End DoDot:1
+58 SET MSGRET=$$GET1^DIQ(779.1,1_",",.07,"I")
+59 IF MSGRET'=36
Begin DoDot:1
+60 SET MSGRET=36
+61 SET DA=1
+62 SET DR=".07///^S X=MSGRET"
+63 DO ^DIE
End DoDot:1
+64 SET BADRET=$$GET1^DIQ(779.1,1_",",.08,"I")
+65 IF BADRET'=7
Begin DoDot:1
+66 SET BADRET=7
+67 SET DA=1
+68 SET DR=".08///^S X=BADRET"
+69 DO ^DIE
End DoDot:1
+70 KILL DIE,DIC,DA,DR,DIR
+71 QUIT
+72 ;
ADDLOGLK ;EP - ADD OR EDIT 'HL LOGICAL LINK'
+1 KILL DIE,DIC,DA,DIR,DR
+2 SET DIC="^HLCS(870,"
+3 SET DIC(0)="LX"
+4 SET X="MPI"
+5 DO ^DIC
+6 IF Y<1
Begin DoDot:1
+7 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("'MPI' NOT ADDED TO HL LOGICAL LINK FILE",IOM)
+8 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("SEE PATCH NOTES AND ADD MANUALLY",IOM)
End DoDot:1
+9 DO LINKMPI(+Y)
+10 ;ADD PORT NUMBER TO REG. PAR. 2203
DO ADDPORT
+11 QUIT
+12 ;
ADDPORT ;EP - ADD PORT
+1 WRITE !!,"ENTER THE SAME MPI LISTENER PORT ENTERED IN THE ENSEMBLE PRODUCTION."
+2 WRITE !,"IF YOU ARE A MULTI-NAMESPACE SITE, YOU MUST ENTER A UNIQUE LISTENER"
+3 WRITE !,"PORT FOR EACH NAMESPACE YOU INSTALL AGMPI IN ON THIS SERVER."
+4 KILL DIR
+5 SET DIR(0)="N^5201:5299"
+6 SET DIR("A")="ENTER MPI LISTENER PORT FOR THIS NAMESPACE"
+7 SET DIR("B")="5201"
+8 DO ^DIR
+9 SET TCPPORT=Y
+10 SET FAC=0
+11 FOR
SET FAC=$ORDER(^AGFAC(FAC))
IF 'FAC
QUIT
Begin DoDot:1
+12 IF $PIECE($GET(^AGFAC(FAC,0)),"^",21)'="Y"
QUIT
+13 KILL DIE,DIR,DA,DR,DIC
+14 SET DIE="^AGFAC("
+15 SET DR="2203///^S X=TCPPORT"
+16 SET DA=FAC
+17 DO ^DIE
End DoDot:1
+18 QUIT
+19 ;
LINKMPI(DA) ;EP - DO EDIT
+1 SET DIE="^HLCS(870,"
+2 SET DEVTYP="Persistent Client"
+3 SET SHUTLLP="NO"
+4 SET LLPTYP="TCP"
+5 SET AUTSTART="Enabled"
+6 SET QUESIZE="10"
+7 SET TCPIP="10.154.33.14"
+8 SET TCPPORT="5200"
+9 SET TCPTYPE="CLIENT (SENDER)"
+10 SET PERS="NO"
+11 ;
+12 SET DR="2///^S X=LLPTYP"
+13 SET DR=DR_";3///^S X=DEVTYP"
+14 SET DR=DR_";4.5///^S X=AUTSTART"
+15 SET DR=DR_";14///^S X=SHUTLLP"
+16 SET DR=DR_";21///^S X=QUESIZE"
+17 SET DR=DR_";400.01///^S X=TCPIP"
+18 SET DR=DR_";400.03///^S X=TCPTYPE"
+19 SET DR=DR_";400.08///^S X=TCPPORT"
+20 SET DR=DR_";400.04///^S X=PERS"
+21 DO ^DIE
+22 KILL DIR,DIE,DIC,DR,DA
+23 QUIT
+24 ;
LINKHLO(DA) ;EP - DO EDIT
+1 ;NOT USED BECASUE EDR STOLE 5026
+2 SET DIE="^HLCS(870,"
+3 SET SHUTLLP="YES"
+4 SET LLPTYP="TCP"
+5 SET QUESIZE="10"
+6 SET TCPIP="127.0.0.1"
+7 SET TCPPORT="5026"
+8 ;
ASKPORT ;EP - ASK PORT
+1 IF $PIECE($GET(^HLD(779.1,1,0)),U)="161.223.93.44"
Begin DoDot:1
+2 WRITE !!,"YOU ARE A CALIFORNIA MULTI NAMESPACE SITE"
+3 WRITE !,"YOU MUST ENTER A UNIQUE LISTENER PORT FOR"
+4 WRITE !,"EACH NAMESPACE YOU INSTALL AGMPI IN"
+5 KILL DIR
+6 SET DIR(0)="N"
+7 SET DIR("A")="ENTER HLO LISTENER PORT ASSIGNED TO YOU"
+8 DO ^DIR
+9 SET TCPPORT=Y
End DoDot:1
IF $DATA(DTOUT)!(DUOUT)!(DTOUT)!(X="")
GOTO ASKPORT
+10 ;
+11 SET DR="2///^S X=LLPTYP"
+12 SET DR=DR_";14///^S X=SHUTLLP"
+13 SET DR=DR_";21///^S X=QUESIZE"
+14 SET DR=DR_";400.01///^S X=TCPIP"
+15 SET DR=DR_";400.03///^S X=TCPTYPE"
+16 SET DR=DR_";400.08///^S X=TCPPORT"
+17 DO ^DIE
+18 KILL DIR,DIE,DIC,DR,DA
+19 QUIT
+20 ;
ADDHLOAP ;EP - ADD 'RPMS-MPI' RECEIVING APP TO HLO APPLICATION REGISTRY
+1 KILL DIE,DIC,DA,DIR,DR
+2 SET DIC="^HLD(779.2,"
+3 SET DIC(0)="L"
+4 SET X="RPMS-MPI"
+5 DO ^DIC
+6 IF Y<0
Begin DoDot:1
+7 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("HLO APPLICATION "_X_" COULD NOT BE ADDED",IOM)
+8 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("TO FILE 779.2",IOM)
+9 IF '$DATA(ZTQUEUED)
WRITE !!,$$CJ^XLFSTR("PLEASE ADD MANUALLY. USE PATCH NOTES",IOM)
End DoDot:1
QUIT
+10 SET RECORD=+Y
+11 KILL DIE,DIC,DA,DIR,DR
+12 SET DIE="^HLD(779.2,"
+13 SET DA=RECORD
+14 SET PRVTQUE="MPI RPMS"
+15 SET ACTTAG="ERR"
+16 SET ACTRTN="AGMPIHLO"
+17 SET PKGLINK="HEALTH LEVEL SEVEN"
+18 SET DR=".03///^S X=PRVTQUE"
+19 SET DR=DR_";.06///^S X=ACTTAG"
+20 SET DR=DR_";.07///^S X=ACTRTN"
+21 SET DR=DR_";2///^S X=PKGLINK"
+22 DO ^DIE
+23 KILL DIE,DIC,DIR,DR,DA
+24 QUIT
+25 ;
+1 NEW RET
+2 SET RET=$$ADD^XPDMENU("AGMENU","AGMP HLO MPI MANAGER OPTIONS","MPI",13)
+3 DO BMES^XPDUTL($$CJ^XLFSTR("MPI Manager Options [AGMP HLO MPI MANAGER OPTIONS] option",80))
+4 DO BMES^XPDUTL($$CJ^XLFSTR("was"_$SELECT(RET:"",1:" NOT")_" added to the Patient registration Menu [AGMENU] ",80))
+5 QUIT
VERUPD ;UPDATE THE PACKAGE VERSION NUMBER
+1 ;GRAB THE BUILD'S VERSION NUMBER
+2 SET BVER=$$VER^XPDUTL(XPDNM)
SET PKG=$$PKG^XPDUTL(XPDNM)
+3 ;SEE WHAT THE INSTALLED VERSION IS
+4 SET IVER=$$VERSION^XPDUTL(PKG)
+5 ;IF THE INSTALLED VERSION LESS THAN THE BUILD'S VERSION, THEN SET THE PACKAGE'S
+6 ;CURRENT VERSION TO THE BUILD'S VERSION
+7 IF IVER<BVER
Begin DoDot:1
+8 SET PKGIEN=$ORDER(^DIC(9.4,"C",PKG,0))
IF PKGIEN'>0
SET PKGIEN=$ORDER(^DIC(9.4,"B",PKG,0))
+9 IF 'PKGIEN
SET XPDABORT=1
DO BMES^XPDUTL("Unable to update package version. Contact OIT for support.")
QUIT
+10 DO PKGVER^XPDIP(PKGIEN,BVER)
End DoDot:1
IF $DATA(XPDABORT)
QUIT
+11 QUIT
