AG72ENMP.m

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

 ;

ADDMENU ;EP - ADD MPI MENU TO AGMENU

 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"","