ABSPP49.m

ABSPP49 ; /IHS/OIT/RAM ; 13 OCT 2017 ; PRE & POST INSTALL ROUTINES FOR ABSP PATCH 49

 ;;1.0;PHARMACY POINT OF SALE;**49**;13 OCT 2017;Build 38

 ; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

 ; /IHS/OIT/RAM ; Entire routine

 ; Preinstall and Postinstall routines for ABSP Patch 49.

 ; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

 ; Q

 ;

ENV ; /IHS/OIT/RAM ; 13 OCT 2017 ; ENVIRONMENT CHECK ROUTINE FOR ABSP PATCH 49

 ;;1.0;PHARMACY POINT OF SALE;**49**;13 OCT 2017

 ;

 N STATTEXT,ZMONTH D INIT

 ;

 N LIST,STATUS,USER,OBJ,CURRNS,DEFEDEST,EDEST,DIR,DIR2,NEWDIR,DIRLEN,DB,SEP,TSC

 N NEWNS,FINDNS,PLOP,NEWGLOBAL,ALLGLOBMAPS,ALLROUTMAPS,ALLPKGMAPS,DEBUG,U

 N CURVER,VER,LASTPATCH,INPUT,ZDD

 S PLOP=0,DEBUG=0,U="^"

 ;

 D MES^XPDUTL("Verifying Installation Environment.")

 I $G(DT)="" D DT^DICRW

 ;

 /* DISABLING THIS CHECK FOR P49. 

 ; CHECKING ON DATA FIELDS THAT WERE MISSING AT CROW -- TROUBLE TICKET 290606.

 S ZDD=$D(^DD(52,9999999.14))&($D(^DD(52,9999999.13)))&($D(^DD(52.1,9999999.13)))

 I 'ZDD {

  D BMES^XPDUTL("Missing at least one of the DUR/PPS fields in File 52. Database structure is comprimised.")

  D MES^XPDUTL("Please put in a ticket with Area/HQ and ask them to reference Ticket #290606.")

  D MES^XPDUTL("Aborting Install.")

  S PLOP=1

 }

 I PLOP G ENVABORT

 E  D BMES^XPDUTL("File 52 structure appears complete!")

 ;

 */

 D BMES^XPDUTL("Checking Patch Prerequisites.... AG package.")

 ;

 ; Let's check AG first, as this patch is dependant on AG*7.1*12 and must be installed first.

 ; Also... keep in mind the AG package has both version 7.1 and 7.2 active branches.

 ;

 S CURVER=$$VERSION^XPDUTL("AG")

 I '(CURVER=7.1!(CURVER=7.2)) {

  D MES^XPDUTL("Current version of the AG package: "_CURVER_" isn't the expected 7.1 or 7.2.")

  D MES^XPDUTL("Aborting Install.")

  S PLOP=1

 }

 I PLOP G ENVABORT

 E  D MES^XPDUTL("AG version ("_CURVER_") level correct!")

 ;

 S LASTPATCH=$$LAST^XPDUTL("AG",7.2)

 I +LASTPATCH'>3 {

   D MES^XPDUTL("Current patch revision of AG 7.2 package: "_+LASTPATCH_" -- requires P4 or newer.")

   S PLOP=1

 }

 I PLOP G ENVABORT

 E  D MES^XPDUTL("AG 7.2 patch level correct!")

 ;

 S LASTPATCH=$$LAST^XPDUTL("AG",7.1)

 I +LASTPATCH'>12 {

   D MES^XPDUTL("Current patch revision of AG 7.1 package: "_+LASTPATCH_" -- requires P13 or newer.")

   S PLOP=1

 }

 I PLOP G ENVABORT

 E  D MES^XPDUTL("AG 7.1 patch level correct!")

 ;

 /*

 S LASTPATCH=$$LAST^XPDUTL("AG",7.1)

 I +LASTPATCH'>10 {

  D MES^XPDUTL("Current patch revision of AG 7.1 package: "_+LASTPATCH_" -- BETA requires P11 or newer.")

  S PLOP=1

 }

 */

 ;

 ; Let's check AUPN next. It's needed for the new MBI patch as well.

 ;

 D BMES^XPDUTL("Checking Patch Prerequisites.... AUPN package.")

 S CURVER=$$VERSION^XPDUTL("AUPN")

 I CURVER'=99.1 {

  D MES^XPDUTL("Current version of the AG package: "_CURVER_" isn't the expected 99.1.")

  D MES^XPDUTL("Aborting Install.")

  S PLOP=1

 }

 I PLOP G ENVABORT

 E  D MES^XPDUTL("AUPN version ("_CURVER_") level correct!")

 ;

 S LASTPATCH=$$LAST^XPDUTL("AUPN",99.1)

 I +LASTPATCH'>25 {

   D MES^XPDUTL("Current patch revision of AUPN 99.1 package: "_+LASTPATCH_" -- requires P26 or newer.")

   S PLOP=1

 }

 I PLOP G ENVABORT

 E  D MES^XPDUTL("AUPN 99.1 patch level correct!")

 ;

 D BMES^XPDUTL("Checking Patch Prerequisites.... ABSP package.")

 ;

 S CURVER=$$VERSION^XPDUTL("ABSP")

 I '(CURVER="1.0") {

  D MES^XPDUTL("Current version of the ABSP package: "_CURVER_" isn't the expected 1.0.")

  D MES^XPDUTL("Aborting Install.")

  S PLOP=1

 }

 I PLOP G ENVABORT

 E  D MES^XPDUTL("ABSP version ("_CURVER_") level correct!")

 ;

 S LASTPATCH=$$LAST^XPDUTL("ABSP",CURVER)

 I +LASTPATCH<47 {

  D MES^XPDUTL("Current patch revision of ABSP 1.0 package: "_+LASTPATCH_" -- requires P47 or newer.")

  S PLOP=1

 }

 I +LASTPATCH>50 {

  D MES^XPDUTL("Current patch revision of ABSP 1.0 package: "_+LASTPATCH_" -- is newer than Patch 50.")

  D MES^XPDUTL("Are you sure that you wish to install this package? ")

  R INPUT#1:120 S INPUT=$$SUP(INPUT)

     I "N"=INPUT S PLOP=1

 }

 I PLOP G ENVABORT

 E  D MES^XPDUTL("ABSP 1.0 patch level within normal parameters!")

 ;

ENVBYE 

 D BMES^XPDUTL("Preinstall Routine complete.")

 ; NEXT IS A WAY FOR ME TO ABORT THE INSTALL EVEN IF IT ALL APPEARS GOOD -- FOR TESTING PORPOISES ONLY.

 I DEBUG {

   N INPUT S PLOP=0

   D MES^XPDUTL("Continue installing da package? ")

   R INPUT:120 S INPUT=$$SUP(INPUT)

   I "N"=INPUT S PLOP=1

 }

 I PLOP G ENVABORT

 Q

 ;

ENVABORT ; "SOMETHING BROKE. ABORT INSTALL AND UNLOAD DISTRIBUTION."

 D BMES^XPDUTL("Environment check routine found issues with the environment.")

 D MES^XPDUTL("This installation will now abort and be unloaded.")

 D MES^XPDUTL("Press any key to continue.")

 ; K DIR S DIR(0)="FA^0:0" D ^DIR

 R PLOP#1:120

 S XPDABORT=1,XPDQUIT=1,XPDQUIT("ABSP*1.0*49")=1

 ;;1.0;PHARMACY POINT OF SALE;**49**;13 OCT 2017

 ;

PRE ; /IHS/OIT/RAM ; 13 OCT 2017 ; PRE-INSTALL ROUTINE FOR ABSP PATCH 49

 ;;1.0;PHARMACY POINT OF SALE;**49**;13 OCT 2017

 ;

 ;

 N STATTEXT,ZMONTH D INIT

 ;

PREBYE ;

 ;;1.0;PHARMACY POINT OF SALE;**49**;13 OCT 2017

 ;

POST ; /IHS/OIT/RAM ; 13 OCT 2017 ; POST-INSTALL ROUTINE FOR ABSP PATCH 49

 ;;1.0;PHARMACY POINT OF SALE;**49**;13 OCT 2017

 ;

 N STATTEXT,ZMONTH D INIT

 ;

 ; LET'S SETUP THE NEW PARAMETER FOR THE BACK BILLING LIMIT. CR# 09828

 ; BUT ONLY SET IT IF ABSP IS ACTUALLY SET UP.

 ;

 I $D(^ABSP(9002313.99,1)) S ^ABSP(9002313.99,1,"BACKLIMIT")=365 ; CHANGE BACK TO 1 YEAR, NEED MORE SPECS ON CR FIRST.

 ;

POSTBYE ;

 Q

 ;

GETPATCHDATA(PKG,ALLPATCH) ; GET ALL ABSP PATCH DATA FROM THE INSTALL FILE.

 ;

 N I,I2,I3,J,J2,J3,K,K2,K3

 N NAME,STATUS,INSTALLBY,COMPLETED,DISTRODATE

 N PACKAGE,VERSION,PATCH,SPACES

 N U S U="^"

 ;

 S (I,I2)=PKG

 F  S I=$O(^XPD(9.7,"B",I)) Q:$E(I,1,$L(I2))'=I2  D

 . S J=0 F  S J=$O(^XPD(9.7,"B",I,J)) Q:+J=0  D

 . . S NAME=$P($G(^XPD(9.7,J,0)),U,1) Q:NAME=""

 . . I NAME["*" D

 . . . S PACKAGE=$P(NAME,"*",1)

 . . . S VERSION=$P(NAME,"*",2)

 . . . S PATCH=$P(NAME,"*",3)

 . . E  D

 . . . S SPACES=$L(NAME," ")

 . . . S VERSION=$P(NAME," ",SPACES)

 . . . S PATCH=0

 . . . S PACKAGE=$P(NAME," ",1,SPACES-1)

 . . S DISTRODATE=$P($G(^XPD(9.7,J,1)),U,4) Q:DISTRODATE=""

 . . S COMPLETED=$P($G(^XPD(9.7,J,1)),U,3) S:COMPLETED="" COMPLETED=DISTRODATE

 . . S STATUS=$P($G(^XPD(9.7,J,0)),U,9) S:STATUS="" STATUS=5

 . . S STATUS=STATTEXT(STATUS)

 . . S INSTALLBY=$P($G(^XPD(9.7,J,0)),U,11) S:INSTALLBY="" INSTALLBY=1

 . . S INSTALLBY=$$GETPERSON(INSTALLBY)

 . . S ALLPATCH(COMPLETED)=PATCH_U_VERSION_U_STATUS_U_NAME_U_DISTRODATE_U_INSTALLBY

 . . ; I STATUS="COMPLETED" S ALLPATCH("P",PACKAGE,VERSION,PATCH,COMPLETED)=INSTALLBY

 ;

 Q

 ;

GETPERSON(IEN) ; TAKE THE 'INSTALLED BY' IEN AND TURN IT INTO A NAME.

 ;

 N NAME

 N U S U="^"

 S NAME=$P($G(^VA(200,IEN,0)),U,1)

 S:NAME="" NAME="UNKNOWN"

 Q NAME

 ;

PREREQ(PKG,VER,PAT) ;

 ; INIT LOCAL VARIABLES

 N ZPATCH,I,I2,I3,J,J2,J3,INST,STOP,LASTPAT,COMPAT

 ; GO GET PATCHES FOR A PACKAGE.

 D GETPATCHDATA(PKG,.ZPATCH)

 ; GET CURRENT VERSION OF PACKAGE. REQUIRED DUE TO ISSUES WITH OLD TEST PACKAGES OF ABSP NUMBERED 1.25 INSTEAD OF 1.0*25.

 S CURVER=$$VERSION^XPDUTL(PKG)

 ;

 ; ; ; IGNORE... ; S LASTPAT=ZPATCH($O(ZPATCH(""),-1)) ; LET'S FIND THE LAST PATCH INSTALLED.

 ; GET LATEST _COMPLETED_  PATCH. 

 S I="",(LASTPAT,STOP)=0 F  S I=$O(ZPATCH(I),-1) D  Q:I=""!STOP

 . I $P($G(ZPATCH(I)),U,3)="COMPLETED" S LASTPAT=I,STOP=1 ; W I,! 

 ; 

 I LASTPAT=0 Q 4 ; RATHER BROKEN; NO PATCH IN THE LIST HAD A 'COMPLETED' STATUS. EXIT ACCORDINGLY.

 ; 

 S COMPAT=ZPATCH(LASTPAT)

 ; 

 ; WE HAVE THE LAST SUCCESSFUL PATCH INSTALL IN COMPAT ; TEST VARIOUS SITUATIONS NEXT.

 S J2=$P($G(COMPAT),U,1),J3=$P($G(COMPAT),U,2) ;; LET'S GET THE PATCH (J2) AND VERSION (J3).

 I J3>CURVER W J3,*9,CURVER," CUR",! Q 1   ; LAST PATCH INSTALLED SHOWS NEWER VERSION THAN CURRENT. POSSIBLE ISSUE WITH INSTALL FILE OR SOMESUCH. EXIT GRUMPILY.

 I J3>VER W J3,*9,VER," VER",! Q 1      ; LAST PATCH INSTALLED SHOWS NEWER VERSION THAN REQUESTED. POSSIBLE ISSUE WITH INSTALL FILE OR CALLING PARAMETERS. EXIT GRUMPILY.

 I J2=PAT Q 0      ; LAST PATCH INSTALLED IS THE PREREQ. EXIT HAPPILY.

 I J2=(PAT+1) Q 0  ; LAST PATCH INSTALLED IS *THIS* PATCH. EXIT HAPPILY AND INSTALL ANYWAY IN CASE PREVIOUS INSTALL WAS A BETA.

 I J2>PAT Q 2      ; LAST PATCH INSTALLED IS NEWER THAN THIS PATCH. EXIT GRUMPILY, BUT CALLING ROUTINE CAN ASK USER IF THEY WANT TO INSTALL ANYWAY.

 I J2<PAT Q 3_U_J2 ; LAST PATCH INSTALLED IS 2+ PATCHES OLDER THAN THIS PATCH. EXIT GRUMPILY; WARN USER TO INSTALL PREVIOUS PATCHES.

 ;

 ; THEN... VERIFY PREREQUISITE EVEN INSTALLED.

NOTOUCHIE ;; LEFTOVER CODE I COULDN'T BRING MYSELF TO DELETE... MIGHT STILL NEED THE LOGIC SOMEDAY. 

 Q 5 ; SHOULD NEVER GET HERE... THIS IS THE "IMPOSSIBLE" RETURN CODE.

 ;

NOTOUCHIE ;; LEFTOVER CODE I COULDN'T BRING MYSELF TO DELETE... MIGHT STILL NEED THE LOGIC SOMEDAY. 

 ;

 ; MORE NOTOUCHIE... =-=-=-=

 Q ;; MAKE SURE WE DON'T ACTUALLY TRY TO EXECUTE ANY OF THE LEFTOVERS...

 ; 

 S STATUS=$$PREREQ("ABSP","1.0",47)

 I +STATUS D  G ENVABORT

 . I +STATUS=1 D MES^XPDUTL("Newer ABSP Major version installed. Exiting.")

 . I +STATUS=2 D MES^XPDUTL("Newer than expected ABSP Patch installed: "_$P(STATUS,U,2)_". Exiting.")

 . I +STATUS=3 D MES^XPDUTL("Older than expected ABSP Patch installed: "_$P(STATUS,U,2)_". Exiting.")

 . I +STATUS=4 D MES^XPDUTL("No ABSP Patches seem to have been installed successfully. Exiting.")

 . I +STATUS=5 D MES^XPDUTL("Unknown error regarding ABSP Patch 47. Contact OIT! Exiting.")

 ;

 D MES^XPDUTL("Required ABSP Patch 47... OK.")

 ;

 S STATUS=$$PREREQ("AG","7.1",12)

 I STATUS D  G ENVABORT

 . I STATUS=1 D MES^XPDUTL("Newer AG Major version installed. Exiting.")

 . I STATUS=2 D MES^XPDUTL("Newer than expected AG Patch installed: "_$P(STATUS,U,2)_". Exiting.")

 . I STATUS=3 D MES^XPDUTL("Older than expected AG Patch installed: "_$P(STATUS,U,2)_". Exiting.")

 . I STATUS=4 D MES^XPDUTL("No AG Patches seem to have been installed successfully. Exiting.")

 . I STATUS=5 D MES^XPDUTL("Unknown error regarding AG Patch 12. Contact OIT! Exiting.")

 ;

 ; =-=-=-=

 ;

 Q ;; MAKE SURE WE DON'T ACTUALLY TRY TO EXECUTE ANY OF THE LEFTOVERS...

 ;

 S (INST,STOP)=0,I="" F  S I=$O(ZPATCH(I),-1) Q:+I=0!STOP  D  ; LOOP THROUGH PATCHES, NEWEST FIRST.

 . S J2=$P($G(ZPATCH(I)),U,1),J3=$P($G(ZPATCH(I)),U,2)

 . I J2=PAT&(J3=VER) S STOP=1                       ; AND SEE IF THE CORRECT PATCH & VERSION NUMBER EXISTS.

 . ; W I,*9,J2,*9,PAT,*9,J3,*9,VER,*9,"YUP",!

 ;

 I 'STOP Q 1 ; LOOP NEVER STOPPED; PREREQ PATCH NOT INSTALLED.

 S I=$O(ZPATCH(I),1) ; MOVE BACK FORWARD ONE NODE ;

 I $P($G(ZPATCH(I)),U,3)'="COMPLETED" Q 3  ; PREREQ STATUS NOT 'COMPLETED'

 ;

 ; STILL HERE? LET'S GO FORWARD FROM CURRENT AND SEE IF AN OLDER PATCH WAS INSTALLED...

 ; OR IF A NEWER MAJOR VERSION OF THE PACKAGE HAS BEEN INSTALLED.

 S STOP=0,I2=I F  S I2=$O(ZPATCH(I2)) Q:+I2=0!STOP  D

 . S J2=$P($G(ZPATCH(I2)),U,1),J3=$P($G(ZPATCH(I2)),U,2)

 . I J2<PAT S STOP=1

 . I J3>VER S STOP=2

 . ; W I2,*9,J2,*9,PAT,*9,J3,*9,VER,*9,"SQEEB",!

 ;

 I STOP=0 Q 0  ;; FORWARD LOOP NEVER STOPPED; OLDER PATCH OR NEWER VERSION NEVER INSTALLED. GOOD TO GO.

 ; THEN... VERIFY CORRECT INSTALLATION ORDER. -- MAKE SURE A PREVIOUS PATCH WASN'T INSTALLED AFTER THE PREREQ.

 I STOP=1 Q 2 ; OLDER PATCH INSTALLED AFTER TARGET PREREQ. RETURN THUSLY.

 ;

 I STOP=2 Q 4 ; NEWER VERSION INSTALLED; WARN THE INSTALLER TO NOT CONTINUE. 

 ;

 ; RETURN CODES:

 ; 0 == ALL GOOD. // 1 == PREREQ NOT INSTALLED. // 2 == EARLIER PATCH INSTALLED AFTER PREREQ. // 3 == PREREQ STATUS NOT 'COMPLETE'

 ; 4 == NEWER MAJOR VERSION INSTALLED // 5 == NEWER PATCH (IN THIS CASE, 49+) INSTALLED. // 6 == UNKNOWN RETURN CODE... "SHOULDN'T HAPPEN."

 ; 

 Q 6  ;; ONLY HIT THIS IF A NEW 'STOP' CODE IS MISPROGRAMMED. 

 ;

INIT ;

 ;

 S STATTEXT(0)="LOADED"

 S STATTEXT(1)="QUEUED"

 S STATTEXT(2)="STARTED"

 S STATTEXT(3)="COMPLETED"

 S STATTEXT(4)="DEINSTALL"

 S STATTEXT(5)="UNKNOWN"

 ;

 S ZMONTH(1)="Jan"

 S ZMONTH(2)="Feb"

 S ZMONTH(3)="Mar"

 S ZMONTH(4)="Apr"

 S ZMONTH(5)="May"

 S ZMONTH(6)="Jun"

 S ZMONTH(7)="Jul"

 S ZMONTH(8)="Aug"

 S ZMONTH(9)="Sep"

 S ZMONTH(10)="Oct"

 S ZMONTH(11)="Nov"

 S ZMONTH(12)="Dec"

 ;

 Q

 ;

SUP(YUP) ; UTILITY TO GRAB JUST THE FIRST CHARACTER AND UPPERCASE IT.

ABSPP49   ; /IHS/OIT/RAM ; 13 OCT 2017 ; PRE & POST INSTALL ROUTINES FOR ABSP PATCH 49

 +1       ;;1.0;PHARMACY POINT OF SALE;**49**;13 OCT 2017;Build 38

 +2       ; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

 +3       ; /IHS/OIT/RAM ; Entire routine

 +4       ; Preinstall and Postinstall routines for ABSP Patch 49.

 +5       ; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

 +6       ; Q

 +7       ;

ENV       ; /IHS/OIT/RAM ; 13 OCT 2017 ; ENVIRONMENT CHECK ROUTINE FOR ABSP PATCH 49

 +1       ;;1.0;PHARMACY POINT OF SALE;**49**;13 OCT 2017

 +2       ;

 +3        NEW STATTEXT,ZMONTH

           DO INIT

 +4       ;

 +5        NEW LIST,STATUS,USER,OBJ,CURRNS,DEFEDEST,EDEST,DIR,DIR2,NEWDIR,DIRLEN,DB,SEP,TSC

 +6        NEW NEWNS,FINDNS,PLOP,NEWGLOBAL,ALLGLOBMAPS,ALLROUTMAPS,ALLPKGMAPS,DEBUG,U

 +7        NEW CURVER,VER,LASTPATCH,INPUT,ZDD

 +8        SET PLOP=0

           SET DEBUG=0

           SET U="^"

 +9       ;

 +10       DO MES^XPDUTL("Verifying Installation Environment.")

 +11       IF $GET(DT)=""

               DO DT^DICRW

 +12      ;

 +13 

*** ERROR ***

 +14      ; CHECKING ON DATA FIELDS THAT WERE MISSING AT CROW -- TROUBLE TICKET 290606.

 +15       SET ZDD=$DATA(^DD(52,9999999.14))&($DATA(^DD(52,9999999.13)))&($DATA(^DD(52.1,9999999.13)))

 +16       IF 'ZDD