Routine: GMPLY49

GMPLY49 ;ISP/TC - Pre/Post Install Routine for GMPL*2.0*49 ;08/23/17  08:15

 ;;2.0;Problem List;**49**;Aug 25, 1994;Build 43

 ; External References:

 ;   ICR  872    PROTOCOL FILE #101

 ;   ICR  1157   OUT^XPDMENU

 ;   ICR  2051   $$FIND1^DIC

 ;   ICR  2053   FILE^DIE

 ;   ICR  10014  EN^DIU2

 ;   ICR  10104  $$LJ/$$UP^XLFSTR

 ;   ICR  10141  BMES/MES/PATCH^XPDUTL

 ;   ICR  10156  OPTION FILE #19

ASGNRPT ; Retrieve pre-existing user/clinic selection list assignment report

 N GMPLULST,GMPLCLST,GMPLELST,GMPLTXT

 D GETUSRLT^GMPLSLRP(.GMPLULST,.GMPLELST)

 D GETCLNLT^GMPLSLRP(.GMPLCLST)

 I $D(GMPLULST)!($D(GMPLCLST))!($D(GMPLELST)) D

 . D SENDARPT(.GMPLULST,.GMPLCLST,.GMPLELST)

 . D MES^XPDUTL("  Report has been generated to the installer & OR CACS mailgroup via MailMan.")

 E  D MES^XPDUTL("  No pre-existing USER or CLINIC selection list assignments found.")

 I $D(GMPLELST) D

 . N GMPLUSR,GMPLLST,GMPLFDA,GMPLDUZ,GMPLMSG,GMPLSUC

 . S (GMPLUSR,GMPLLST)="",GMPLSUC=1

 . D BMES^XPDUTL("  Removing invalid USER selection list assignments for...")

 . F  S GMPLUSR=$O(GMPLELST(GMPLUSR)) Q:GMPLUSR=""  D

 . . F  S GMPLLST=$O(GMPLELST(GMPLUSR,GMPLLST)) Q:GMPLLST=""  D

 . . . D MES^XPDUTL("     "_GMPLUSR_": Invalid Selection List #"_GMPLLST_"")

 . . . S GMPLDUZ=$G(GMPLELST(GMPLUSR,GMPLLST))

 . . . S GMPLFDA(200,""_GMPLDUZ_",",125.1)="@"

 . . . D FILE^DIE("K","GMPLFDA","GMPLMSG")

 . . . I $D(GMPLMSG) S GMPLSUC=0 D MES^XPDUTL("     Error: "_GMPLMSG("DIERR",1,"TEXT",1))

 . I GMPLSUC D MES^XPDUTL("  Done.")

 K GMPLULST,GMPLCLST,GMPLELST

CASECHK ; Check for mixed/lower case list/category name entries

 N GMPLLIST,GMPLCAT,GMPLLNM,GMPLCNM,GMPLLDA,GMPLCDA,GMPLMSG,GMPLFDA,GMPLERR,GMPLTXT

 S (GMPLLNM,GMPLCNM,GMPLLDA,GMPLCDA)=""

 F  S GMPLLNM=$O(^GMPL(125,"B",GMPLLNM)) Q:GMPLLNM=""  D

 . F  S GMPLLDA=$O(^GMPL(125,"B",GMPLLNM,GMPLLDA)) Q:GMPLLDA=""  D

 . . I $$MIXLOWCS^GMPLX(GMPLLNM) D

 . . . S GMPLFDA(125,""_GMPLLDA_",",.01)=$$UP^XLFSTR(GMPLLNM)

 . . . D FILE^DIE("EK","GMPLFDA","GMPLMSG")

 . . . I $D(GMPLMSG) D

 . . . . S GMPLLIST("FAIL",GMPLLNM)="Record #"_GMPLLDA_U_"Error: "_GMPLMSG("DIERR",1,"TEXT",1)

 . . . . K GMPLMSG

 . . . E  S GMPLLIST("PASS",GMPLLNM)=""

 F  S GMPLCNM=$O(^GMPL(125.11,"B",GMPLCNM)) Q:GMPLCNM=""  D

 . F  S GMPLCDA=$O(^GMPL(125.11,"B",GMPLCNM,GMPLCDA)) Q:GMPLCDA=""  D

 . . I $$MIXLOWCS^GMPLX(GMPLCNM) D

 . . . S GMPLFDA(125.11,""_GMPLCDA_",",.01)=$$UP^XLFSTR(GMPLCNM)

 . . . D FILE^DIE("EK","GMPLFDA","GMPLERR")

 . . . I $D(GMPLERR) D

 . . . . S GMPLCAT("FAIL",GMPLCNM)="Record #"_GMPLCDA_U_"Error: "_GMPLERR("DIERR",1,"TEXT",1)

 . . . . K GMPLERR

 . . . E  S GMPLCAT("PASS",GMPLCNM)=""

 I $D(GMPLLIST)!($D(GMPLCAT)) D

 . D SENDCRPT(.GMPLLIST,.GMPLCAT)

 . S GMPLTXT(1)="  A mixed & lower case list/category name report has been generated to the"

 . S GMPLTXT(2)="  installer and OR CACS mailgroup via MailMan."

 . D BMES^XPDUTL(.GMPLTXT)

 E  D MES^XPDUTL("  No mixed or lower case list/category names found.")

 K GMPLLIST,GMPLCAT,GMPLMSG

DUPCHK ; Check for duplicate selection list/category entry names

 N GMPLSLST,GMPLCLST,GMPLDUPL,GMPLDUPC,GMPLLNM,GMPLCNM,GMPLTXT,GMPLIEN,GMPLDA

 S (GMPLLNM,GMPLCNM)="",GMPLSLST("0")="",GMPLCLST("0")="",(GMPLIEN,GMPLDA)=0

 F  S GMPLLNM=$O(^GMPL(125,"B",GMPLLNM)) Q:GMPLLNM=""  D

 . F  S GMPLIEN=$O(^GMPL(125,"B",GMPLLNM,GMPLIEN)) Q:'GMPLIEN  D

 . . I $$DUPL(.GMPLSLST,GMPLLNM) S GMPLDUPL(GMPLLNM)=""

 . . S GMPLSLST(GMPLLNM)=""

 F  S GMPLCNM=$O(^GMPL(125.11,"B",GMPLCNM)) Q:GMPLCNM=""  D

 . F  S GMPLDA=$O(^GMPL(125.11,"B",GMPLCNM,GMPLDA)) Q:'GMPLDA  D

 . . I $$DUPL(.GMPLCLST,GMPLCNM) S GMPLDUPC(GMPLCNM)=""

 . . S GMPLCLST(GMPLCNM)=""

 I $D(GMPLDUPL)!($D(GMPLDUPC)) D

 . D SENDDRPT(.GMPLDUPL,.GMPLDUPC)

 . S GMPLTXT(1)="  A duplicate list/category name report has been generated to the installer"

 . S GMPLTXT(2)="  and OR CACS mailgroup via MailMan."

 . D BMES^XPDUTL(.GMPLTXT)

 E  D MES^XPDUTL("  No duplicate list/category names found.")

 K GMPLSLST,GMPLCLST,GMPLDUPL,GMPLDUPC

DUPL(GMPLARY,GMPLENT) ; Check if GMPLENT is a duplicate in GMPLARY

 N GMPLSUB,GMPLRSLT S GMPLSUB="",GMPLRSLT=0

 F  S GMPLSUB=$O(GMPLARY(GMPLSUB)) Q:GMPLSUB=""  D

 . I $$UP^XLFSTR(GMPLENT)=$$UP^XLFSTR(GMPLSUB) S GMPLRSLT=1 Q

 Q GMPLRSLT

POST ; Post-install subroutine

 N GMPLOPT,GMPLOTXT

 D BMES^XPDUTL("  Scanning for duplicate Problem Selection list/category names...")

 D DUPCHK

 D BMES^XPDUTL("  Marking GMPL CODE LIST menu option out of order...")

 S GMPLOPT="GMPL CODE LIST",GMPLOTXT="This option is obsolete and disabled."

 D OUT^XPDMENU(GMPLOPT,GMPLOTXT),MES^XPDUTL("  Done.")

 D UPCHKMNU

 D BMES^XPDUTL("  Updating display order of several items for GMPL BUILD LIST MENU option...")

 D UPDTDORD

 D BMES^XPDUTL("  Resequencing GMPL MENU BUILD GROUP protocol menu items...")

 D RSEQPROT

 Q:$$PATCH^XPDUTL("GMPL*2.0*49")

 D EN^GMPLY49A

PRE ; Pre-install subroutine

 ; Remove old data dictionary for the Problem Selection List Files

 N DIU

 D BMES^XPDUTL("  Retrieving pre-existing USER/CLINIC selection list assignment report...")

 D ASGNRPT

 D BMES^XPDUTL("  Scanning for mixed or lower case Problem Selection list/category names...")

 D CASECHK

 D BMES^XPDUTL("  Removing old PROBLEM SELECTION LIST file #125 data dictionary...")

 S DIU(0)=""

 S DIU=125

 D EN^DIU2 K DIU

 D MES^XPDUTL("  Data dictionary for file #125 removed.")

 N DIU

 D BMES^XPDUTL("  Removing old PROBLEM SELECTION CATEGORY file #125.11 data dictionary...")

 S DIU(0)=""

 S DIU=125.11

 D EN^DIU2 K DIU

 D MES^XPDUTL("  Data dictionary for file #125.11 removed.")

 I $D(^GMPL(125,0)) S $P(^GMPL(125,0),U,3)=0

 I $D(^GMPL(125.11,0)) S $P(^GMPL(125.11,0),U,3)=0

RSEQPROT ; Resequence GMPL MENU BUILD GROUP protocol menu items

 N GMPLPIEN,GMPLMSG,GMPLDA,GMPLITEM,GMPLIENS,GMPLFDA,GMPLTXT,GMPLERR

 S GMPLDA=0,GMPLERR=0

 S GMPLPIEN=$$FIND1^DIC(101,"","BX","GMPL MENU BUILD GROUP","","","GMPLMSG")

 I 'GMPLPIEN D BMES^XPDUTL("  Error: Cannot find GMPL MENU BUILD GROUP protocol.") Q

 F  S GMPLDA=$O(^ORD(101,GMPLPIEN,10,GMPLDA)) Q:GMPLDA=""  D

 . S GMPLITEM=$G(^ORD(101,GMPLPIEN,10,GMPLDA,0))

 . I $P(GMPLITEM,U,2)="ED" D  Q

 . . S GMPLIENS=""_GMPLDA_","_GMPLPIEN_","

 . . S GMPLFDA(101.01,GMPLIENS,.01)="GMPL MENU COPY GROUP"

 . . S GMPLFDA(101.01,GMPLIENS,2)="CN"

 . . S GMPLFDA(101.01,GMPLIENS,3)="5"

 . . D FILE^DIE("EK","GMPLFDA","GMPLMSG")

 . . I $D(GMPLMSG) D

 . . . S GMPLTXT(1)="  Unable to add GMPL MENU COPY GROUP as the 5th menu item. "

 . . . S GMPLTXT(2)="  Error: "_GMPLMSG("DIERR",1,"TEXT",1),GMPLERR=1

 . . . D BMES^XPDUTL(.GMPLTXT)

 I 'GMPLERR D MES^XPDUTL("  Done.")

SENDARPT(GMPLULST,GMPLCLST,GMPLELST) ; Build pre-existing user/clinic selection list assignment rpt and send via MailMan

 N GMPLTO,GMPLFROM,GMPXMSUB,SUB,GMPLCNT

 K ^TMP("GMPLASGN",$J)

 S SUB="GMPLASGN",GMPLCNT=9

 S GMPXMSUB="Pre-existing USER/CLINIC Selection List Assignment Report"

 S GMPLFROM="GMPL*2.0*49 INSTALL"

 S GMPLTO(DUZ)="",GMPLTO("G.OR CACS")=""

 S ^TMP(SUB,$J,1,0)=""

 S ^TMP(SUB,$J,2,0)="This report was auto generated during installation to identify Problem"

 S ^TMP(SUB,$J,3,0)="Selection Lists assigned to users and clinics prior to the installation of"

 S ^TMP(SUB,$J,4,0)="GMPL*2.0*49. After installation all users and clinic assignments will be"

 S ^TMP(SUB,$J,5,0)="migrated to the new Default Selection List Display parameter setting. If users"

 S ^TMP(SUB,$J,6,0)="and clinics desire to use the National Problem Selection List as their default"

 S ^TMP(SUB,$J,7,0)="setting then use the Assign/Remove menu option to reassign those users or"

 S ^TMP(SUB,$J,8,0)="clinics listed in the report."

 S ^TMP(SUB,$J,9,0)=""

 I $D(GMPLULST) D

 . N GMPLUSR,GMPLST S (GMPLUSR,GMPLST)=""

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="User Selection List Assignments: "

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 . F  S GMPLUSR=$O(GMPLULST(GMPLUSR)) Q:GMPLUSR=""  D

 . . F  S GMPLST=$O(GMPLULST(GMPLUSR,GMPLST)) Q:GMPLST=""  D

 . . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="   "_$$LJ^XLFSTR(GMPLUSR,35)_$$LJ^XLFSTR(GMPLST,40)

 E  S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="There are no USER selection list assignments in the system currently."

 S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 I $D(GMPLCLST) D

 . N GMPLCLIN,GMPLLST S (GMPLCLIN,GMPLLST)=""

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="Clinic Selection List Assignments: "

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 . F  S GMPLCLIN=$O(GMPLCLST(GMPLCLIN)) Q:GMPLCLIN=""  D

 . . F  S GMPLLST=$O(GMPLCLST(GMPLCLIN,GMPLLST)) Q:GMPLLST=""  D

 . . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="   "_$$LJ^XLFSTR(GMPLCLIN,35)_$$LJ^XLFSTR(GMPLLST,40)

 E  S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="There are no CLINIC selection list assignments in the system currently."

 I $D(GMPLELST) D

 . N GMPLUSNM,GMPLSLDA S (GMPLUSNM,GMPLSLDA)=""

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="User(s) assigned to a Selection List that no longer exists:"

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 . F  S GMPLUSNM=$O(GMPLELST(GMPLUSNM)) Q:GMPLUSNM=""  D

 . . F  S GMPLSLDA=$O(GMPLELST(GMPLUSNM,GMPLSLDA)) Q:GMPLSLDA=""  D

 . . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="   "_$$LJ^XLFSTR(GMPLUSNM,35)_$$LJ^XLFSTR("Selection List #"_GMPLSLDA,40)

 D SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)

SENDCRPT(GMPLLIST,GMPLCAT) ; Build mix/lower case name report and send to installer via MailMan

 N GMPLTO,GMPLFROM,GMPXMSUB,SUB,GMPLCNT,GMPLLNM,GMPLCNM

 K ^TMP("GMPLCASE",$J)

 S SUB="GMPLCASE",GMPLCNT=9,(GMPLLNM,GMPLCNM)=""

 S GMPXMSUB="Mixed & Lower Case List/Category Name Report"

 S GMPLFROM="GMPL*2.0*49 INSTALL"

 S GMPLTO(DUZ)="",GMPLTO("G.OR CACS")=""

 S ^TMP(SUB,$J,1,0)=""

 S ^TMP(SUB,$J,2,0)="Mixed/lower case problem selection list/category names are no longer allowed"

 S ^TMP(SUB,$J,3,0)="with patch GMPL*2.0*49. This patch scans the Problem Selection List and Problem"

 S ^TMP(SUB,$J,4,0)="Selection Category files for any names in mixed or lower case letters and"

 S ^TMP(SUB,$J,5,0)="converts them to upper case."

 S ^TMP(SUB,$J,6,0)=""

 S ^TMP(SUB,$J,7,0)="For those conversions that failed, please have a CAC or somebody with FileMan"

 S ^TMP(SUB,$J,8,0)="access manually modify the name to upper case."

 S ^TMP(SUB,$J,9,0)=""

 I $D(GMPLLIST("PASS")) D

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="The following list names converted successfully:"

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 . F  S GMPLLNM=$O(GMPLLIST("PASS",GMPLLNM)) Q:GMPLLNM=""  D

 . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="     "_GMPLLNM

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 I $D(GMPLLIST("FAIL")) D

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="Failed list names:"

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="",GMPLLNM=""

 . F  S GMPLLNM=$O(GMPLLIST("FAIL",GMPLLNM)) Q:GMPLLNM=""  D

 . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=$$LJ^XLFSTR("*"_GMPLLNM,34)_$$LJ^XLFSTR($P(GMPLLIST("FAIL",GMPLLNM),U),18)_$$LJ^XLFSTR($P(GMPLLIST("FAIL",GMPLLNM),U,2),80)

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 I $D(GMPLCAT("PASS")) D

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="The following category names converted successfully:"

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 . F  S GMPLCNM=$O(GMPLCAT("PASS",GMPLCNM)) Q:GMPLCNM=""  D

 . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="     "_GMPLCNM

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 I $D(GMPLCAT("FAIL")) D

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="Failed category names:"

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="",GMPLCNM=""

 . F  S GMPLCNM=$O(GMPLCAT("FAIL",GMPLCNM)) Q:GMPLCNM=""  D

 . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=$$LJ^XLFSTR("*"_GMPLCNM,34)_$$LJ^XLFSTR($P(GMPLCAT("FAIL",GMPLCNM),U),18)_$$LJ^XLFSTR($P(GMPLCAT("FAIL",GMPLCNM),U,2),80)

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 D SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)

SENDDRPT(GMPLDUPL,GMPLDUPC) ; Build duplicate name report and send to installer via MailMan

 N GMPLTO,GMPLFROM,GMPXMSUB,SUB,GMPLCNT,GMPLLIST,GMPLCAT

 K ^TMP("GMPLDUP",$J)

 S SUB="GMPLDUP",GMPLCNT=6,(GMPLLIST,GMPLCAT)=""

 S GMPXMSUB="Duplicate Problem Selection List/Category Name Report"

 S GMPLFROM="GMPL*2.0*49 INSTALL"

 S GMPLTO(DUZ)="",GMPLTO("G.OR CACS")=""

 S ^TMP(SUB,$J,1,0)=""

 S ^TMP(SUB,$J,2,0)="Duplicate problem selection list/category names are no longer allowed with"

 S ^TMP(SUB,$J,3,0)="patch GMPL*2.0*49. The following list/category names are duplicates. Please"

 S ^TMP(SUB,$J,4,0)="have your CAC review these with the pre-existing file entries and rename,"

 S ^TMP(SUB,$J,5,0)="delete, or reconcile the duplicate entries as needed."

 S ^TMP(SUB,$J,6,0)=""

 I $D(GMPLDUPL) D

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="     Duplicate List Names:"

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 . F  S GMPLLIST=$O(GMPLDUPL(GMPLLIST)) Q:GMPLLIST=""  D

 . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="     "_GMPLLIST

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 I $D(GMPLDUPC) D

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="     Duplicate Category Names:"

 . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)=""

 . F  S GMPLCAT=$O(GMPLDUPC(GMPLCAT)) Q:GMPLCAT=""  D

 . . S GMPLCNT=GMPLCNT+1,^TMP(SUB,$J,GMPLCNT,0)="     "_GMPLCAT

 D SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)

SENDLIST(GMPLSLST) ; Export national list/category data if prefixed with VA-

 I $E(GMPLSLST,1,3)="VA-" Q 1

Q 0

UPCHKMNU ; Update GMPL SELECTION LIST CSV CHECK menu text

 N GMPLIEN,GMPLFDA,GMPLMSG,GMPLERR,GMPLTXT

 S GMPLIEN=+$$FIND1^DIC(19,"","KX","GMPL SELECTION LIST CSV CHECK","","","GMPLMSG")

 I GMPLIEN>0 D

 . D BMES^XPDUTL("  Updating GMPL SELECTION LIST CSV CHECK menu text...")

 . S GMPLFDA(19,""_GMPLIEN_",",1)="Check Problem Selection List Problem Codes"

 . D FILE^DIE("EK","GMPLFDA","GMPLERR")

 I $D(GMPLERR) D

 . S GMPLTXT(1)="  Error updating menu text."

 . S GMPLTXT(2)="  Error "_GMPLERR("DIERR",1)_": "_GMPLERR("DIERR",1,"TEXT",1)

 . D BMES^XPDUTL(.GMPLTXT)

 E  D MES^XPDUTL("  Done.")

UPDTDORD ; Update display order of several menu items for GMPL BUILD LIST MENU option

 N GMPLI,GMPLOIEN,GMPLMSG,GMPLTXT,GMPLERR S GMPLERR=0

 S GMPLOIEN=$$FIND1^DIC(19,"","BX","GMPL BUILD LIST MENU","","","GMPLMSG")

 I 'GMPLOIEN D BMES^XPDUTL("  Error: Cannot find GMPL BUILD LIST MENU option") Q

 F GMPLI=1:1:3 D

 . N GMPLOPT,GMPLMIEN,GMPLIENS,GMPLVAL,GMPLFDA

 . S GMPLOPT=$S(GMPLI=1:"GMPL DELETE LIST",GMPLI=2:"GMPL SELECTION LIST CSV CHECK",1:"GMPL SELECTION LIST IMPORT")

 . S GMPLVAL=$S(GMPLI=1:"4",GMPLI=2:"5",1:"6")

 . S GMPLMIEN=$$FIND1^DIC(19.01,","_GMPLOIEN_",","BX",GMPLOPT,"","","GMPLMSG")

 . S GMPLIENS=""_GMPLMIEN_","_GMPLOIEN_","

 . S GMPLFDA(19.01,GMPLIENS,2)=GMPLVAL

 . S GMPLFDA(19.01,GMPLIENS,3)=GMPLVAL

 . D FILE^DIE("EK","GMPLFDA","GMPLMSG")

 . I $D(GMPLMSG) D

 . . S GMPLTXT(1)="  Menu Item: "_GMPLOPT

 . . S GMPLTXT(2)="  Error: "_GMPLMSG("DIERR",1,"TEXT",1),GMPLERR=1

 . . D BMES^XPDUTL(.GMPLTXT)

 I 'GMPLERR D MES^XPDUTL("  Done.")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLY49   15231     printed  Mar 13, 2025@21:35:25                                                                                                                                                                                                    Page 2

GMPLY49   ;ISP/TC - Pre/Post Install Routine for GMPL*2.0*49 ;08/23/17  08:15

 +1       ;;2.0;Problem List;**49**;Aug 25, 1994;Build 43

 +2       ;

 +3       ; External References:

 +4       ;   ICR  872    PROTOCOL FILE #101

 +5       ;   ICR  1157   OUT^XPDMENU

 +6       ;   ICR  2051   $$FIND1^DIC

 +7       ;   ICR  2053   FILE^DIE

 +8       ;   ICR  10014  EN^DIU2

 +9       ;   ICR  10104  $$LJ/$$UP^XLFSTR

 +10      ;   ICR  10141  BMES/MES/PATCH^XPDUTL

 +11      ;   ICR  10156  OPTION FILE #19

 +12      ;

ASGNRPT   ; Retrieve pre-existing user/clinic selection list assignment report

 +1        NEW GMPLULST,GMPLCLST,GMPLELST,GMPLTXT

 +2        DO GETUSRLT^GMPLSLRP(.GMPLULST,.GMPLELST)

 +3        DO GETCLNLT^GMPLSLRP(.GMPLCLST)

 +4        IF $DATA(GMPLULST)!($DATA(GMPLCLST))!($DATA(GMPLELST))

               Begin DoDot:1

 +5                DO SENDARPT(.GMPLULST,.GMPLCLST,.GMPLELST)

 +6                DO MES^XPDUTL("  Report has been generated to the installer & OR CACS mailgroup via MailMan.")

               End DoDot:1

 +7       IF '$TEST

               DO MES^XPDUTL("  No pre-existing USER or CLINIC selection list assignments found.")

 +8        IF $DATA(GMPLELST)

               Begin DoDot:1

 +9                NEW GMPLUSR,GMPLLST,GMPLFDA,GMPLDUZ,GMPLMSG,GMPLSUC

 +10               SET (GMPLUSR,GMPLLST)=""

                   SET GMPLSUC=1

 +11               DO BMES^XPDUTL("  Removing invalid USER selection list assignments for...")

 +12               FOR

                       SET GMPLUSR=$ORDER(GMPLELST(GMPLUSR))

                       if GMPLUSR=""

                           QUIT

                       Begin DoDot:2

 +13                       FOR

                               SET GMPLLST=$ORDER(GMPLELST(GMPLUSR,GMPLLST))

                               if GMPLLST=""

                                   QUIT

                               Begin DoDot:3

 +14                               DO MES^XPDUTL("     "_GMPLUSR_": Invalid Selection List #"_GMPLLST_"")

 +15                               SET GMPLDUZ=$GET(GMPLELST(GMPLUSR,GMPLLST))

 +16                               SET GMPLFDA(200,""_GMPLDUZ_",",125.1)="@"

 +17                               DO FILE^DIE("K","GMPLFDA","GMPLMSG")

 +18                               IF $DATA(GMPLMSG)

                                       SET GMPLSUC=0

                                       DO MES^XPDUTL("     Error: "_GMPLMSG("DIERR",1,"TEXT",1))

                               End DoDot:3

                       End DoDot:2

 +19               IF GMPLSUC

                       DO MES^XPDUTL("  Done.")

               End DoDot:1

 +20       KILL GMPLULST,GMPLCLST,GMPLELST

 +21       QUIT

 +22      ;

CASECHK   ; Check for mixed/lower case list/category name entries

 +1        NEW GMPLLIST,GMPLCAT,GMPLLNM,GMPLCNM,GMPLLDA,GMPLCDA,GMPLMSG,GMPLFDA,GMPLERR,GMPLTXT

 +2        SET (GMPLLNM,GMPLCNM,GMPLLDA,GMPLCDA)=""

 +3        FOR

               SET GMPLLNM=$ORDER(^GMPL(125,"B",GMPLLNM))

               if GMPLLNM=""

                   QUIT

               Begin DoDot:1

 +4                FOR

                       SET GMPLLDA=$ORDER(^GMPL(125,"B",GMPLLNM,GMPLLDA))

                       if GMPLLDA=""

                           QUIT

                       Begin DoDot:2

 +5                        IF $$MIXLOWCS^GMPLX(GMPLLNM)

                               Begin DoDot:3

 +6                                SET GMPLFDA(125,""_GMPLLDA_",",.01)=$$UP^XLFSTR(GMPLLNM)

 +7                                DO FILE^DIE("EK","GMPLFDA","GMPLMSG")

 +8                                IF $DATA(GMPLMSG)

                                       Begin DoDot:4

 +9                                        SET GMPLLIST("FAIL",GMPLLNM)="Record #"_GMPLLDA_U_"Error: "_GMPLMSG("DIERR",1,"TEXT",1)

 +10                                       KILL GMPLMSG

                                       End DoDot:4

 +11                              IF '$TEST

                                       SET GMPLLIST("PASS",GMPLLNM)=""

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       FOR

               SET GMPLCNM=$ORDER(^GMPL(125.11,"B",GMPLCNM))

               if GMPLCNM=""

                   QUIT

               Begin DoDot:1

 +13               FOR

                       SET GMPLCDA=$ORDER(^GMPL(125.11,"B",GMPLCNM,GMPLCDA))

                       if GMPLCDA=""

                           QUIT

                       Begin DoDot:2

 +14                       IF $$MIXLOWCS^GMPLX(GMPLCNM)

                               Begin DoDot:3

 +15                               SET GMPLFDA(125.11,""_GMPLCDA_",",.01)=$$UP^XLFSTR(GMPLCNM)

 +16                               DO FILE^DIE("EK","GMPLFDA","GMPLERR")

 +17                               IF $DATA(GMPLERR)

                                       Begin DoDot:4

 +18                                       SET GMPLCAT("FAIL",GMPLCNM)="Record #"_GMPLCDA_U_"Error: "_GMPLERR("DIERR",1,"TEXT",1)

 +19                                       KILL GMPLERR

                                       End DoDot:4

 +20                              IF '$TEST

                                       SET GMPLCAT("PASS",GMPLCNM)=""

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +21       IF $DATA(GMPLLIST)!($DATA(GMPLCAT))

               Begin DoDot:1

 +22               DO SENDCRPT(.GMPLLIST,.GMPLCAT)

 +23               SET GMPLTXT(1)="  A mixed & lower case list/category name report has been generated to the"

 +24               SET GMPLTXT(2)="  installer and OR CACS mailgroup via MailMan."

 +25               DO BMES^XPDUTL(.GMPLTXT)

               End DoDot:1

 +26      IF '$TEST

               DO MES^XPDUTL("  No mixed or lower case list/category names found.")

 +27       KILL GMPLLIST,GMPLCAT,GMPLMSG

 +28       QUIT

 +29      ;

DUPCHK    ; Check for duplicate selection list/category entry names

 +1        NEW GMPLSLST,GMPLCLST,GMPLDUPL,GMPLDUPC,GMPLLNM,GMPLCNM,GMPLTXT,GMPLIEN,GMPLDA

 +2        SET (GMPLLNM,GMPLCNM)=""

           SET GMPLSLST("0")=""

           SET GMPLCLST("0")=""

           SET (GMPLIEN,GMPLDA)=0

 +3        FOR

               SET GMPLLNM=$ORDER(^GMPL(125,"B",GMPLLNM))

               if GMPLLNM=""

                   QUIT

               Begin DoDot:1

 +4                FOR

                       SET GMPLIEN=$ORDER(^GMPL(125,"B",GMPLLNM,GMPLIEN))

                       if 'GMPLIEN

                           QUIT

                       Begin DoDot:2

 +5                        IF $$DUPL(.GMPLSLST,GMPLLNM)

                               SET GMPLDUPL(GMPLLNM)=""

 +6                        SET GMPLSLST(GMPLLNM)=""

                       End DoDot:2

               End DoDot:1

 +7        FOR

               SET GMPLCNM=$ORDER(^GMPL(125.11,"B",GMPLCNM))

               if GMPLCNM=""

                   QUIT

               Begin DoDot:1

 +8                FOR

                       SET GMPLDA=$ORDER(^GMPL(125.11,"B",GMPLCNM,GMPLDA))

                       if 'GMPLDA

                           QUIT

                       Begin DoDot:2

 +9                        IF $$DUPL(.GMPLCLST,GMPLCNM)

                               SET GMPLDUPC(GMPLCNM)=""

 +10                       SET GMPLCLST(GMPLCNM)=""

                       End DoDot:2

               End DoDot:1

 +11       IF $DATA(GMPLDUPL)!($DATA(GMPLDUPC))

               Begin DoDot:1

 +12               DO SENDDRPT(.GMPLDUPL,.GMPLDUPC)

 +13               SET GMPLTXT(1)="  A duplicate list/category name report has been generated to the installer"

 +14               SET GMPLTXT(2)="  and OR CACS mailgroup via MailMan."

 +15               DO BMES^XPDUTL(.GMPLTXT)

               End DoDot:1

 +16      IF '$TEST

               DO MES^XPDUTL("  No duplicate list/category names found.")

 +17       KILL GMPLSLST,GMPLCLST,GMPLDUPL,GMPLDUPC

 +18       QUIT

 +19      ;

DUPL(GMPLARY,GMPLENT) ; Check if GMPLENT is a duplicate in GMPLARY

 +1        NEW GMPLSUB,GMPLRSLT

           SET GMPLSUB=""

           SET GMPLRSLT=0

 +2        FOR

               SET GMPLSUB=$ORDER(GMPLARY(GMPLSUB))

               if GMPLSUB=""

                   QUIT

               Begin DoDot:1

 +3                IF $$UP^XLFSTR(GMPLENT)=$$UP^XLFSTR(GMPLSUB)

                       SET GMPLRSLT=1

                       QUIT

               End DoDot:1

 +4        QUIT GMPLRSLT

 +5       ;

POST      ; Post-install subroutine

 +1        NEW GMPLOPT,GMPLOTXT

 +2        DO BMES^XPDUTL("  Scanning for duplicate Problem Selection list/category names...")

 +3        DO DUPCHK

 +4        DO BMES^XPDUTL("  Marking GMPL CODE LIST menu option out of order...")

 +5        SET GMPLOPT="GMPL CODE LIST"

           SET GMPLOTXT="This option is obsolete and disabled."

 +6        DO OUT^XPDMENU(GMPLOPT,GMPLOTXT)

           DO MES^XPDUTL("  Done.")

 +7        DO UPCHKMNU

 +8        DO BMES^XPDUTL("  Updating display order of several items for GMPL BUILD LIST MENU option...")

 +9        DO UPDTDORD

 +10       DO BMES^XPDUTL("  Resequencing GMPL MENU BUILD GROUP protocol menu items...")

 +11       DO RSEQPROT

 +12       if $$PATCH^XPDUTL("GMPL*2.0*49")

               QUIT

 +13       DO EN^GMPLY49A

 +14       QUIT

 +15      ;

PRE       ; Pre-install subroutine

 +1       ; Remove old data dictionary for the Problem Selection List Files

 +2        NEW DIU

 +3        DO BMES^XPDUTL("  Retrieving pre-existing USER/CLINIC selection list assignment report...")

 +4        DO ASGNRPT

 +5        DO BMES^XPDUTL("  Scanning for mixed or lower case Problem Selection list/category names...")

 +6        DO CASECHK

 +7        DO BMES^XPDUTL("  Removing old PROBLEM SELECTION LIST file #125 data dictionary...")

 +8        SET DIU(0)=""

 +9        SET DIU=125

 +10       DO EN^DIU2

           KILL DIU

 +11       DO MES^XPDUTL("  Data dictionary for file #125 removed.")

 +12       NEW DIU

 +13       DO BMES^XPDUTL("  Removing old PROBLEM SELECTION CATEGORY file #125.11 data dictionary...")

 +14       SET DIU(0)=""

 +15       SET DIU=125.11

 +16       DO EN^DIU2

           KILL DIU

 +17       DO MES^XPDUTL("  Data dictionary for file #125.11 removed.")

 +18       IF $DATA(^GMPL(125,0))

               SET $PIECE(^GMPL(125,0),U,3)=0

 +19       IF $DATA(^GMPL(125.11,0))

               SET $PIECE(^GMPL(125.11,0),U,3)=0

 +20       QUIT

 +21      ;

RSEQPROT  ; Resequence GMPL MENU BUILD GROUP protocol menu items

 +1        NEW GMPLPIEN,GMPLMSG,GMPLDA,GMPLITEM,GMPLIENS,GMPLFDA,GMPLTXT,GMPLERR

 +2        SET GMPLDA=0

           SET GMPLERR=0

 +3        SET GMPLPIEN=$$FIND1^DIC(101,"","BX","GMPL MENU BUILD GROUP","","","GMPLMSG")

 +4        IF 'GMPLPIEN

               DO BMES^XPDUTL("  Error: Cannot find GMPL MENU BUILD GROUP protocol.")

               QUIT

 +5        FOR

               SET GMPLDA=$ORDER(^ORD(101,GMPLPIEN,10,GMPLDA))

               if GMPLDA=""

                   QUIT

               Begin DoDot:1

 +6                SET GMPLITEM=$GET(^ORD(101,GMPLPIEN,10,GMPLDA,0))

 +7                IF $PIECE(GMPLITEM,U,2)="ED"

                       Begin DoDot:2

 +8                        SET GMPLIENS=""_GMPLDA_","_GMPLPIEN_","

 +9                        SET GMPLFDA(101.01,GMPLIENS,.01)="GMPL MENU COPY GROUP"

 +10                       SET GMPLFDA(101.01,GMPLIENS,2)="CN"

 +11                       SET GMPLFDA(101.01,GMPLIENS,3)="5"

 +12                       DO FILE^DIE("EK","GMPLFDA","GMPLMSG")

 +13                       IF $DATA(GMPLMSG)

                               Begin DoDot:3

 +14                               SET GMPLTXT(1)="  Unable to add GMPL MENU COPY GROUP as the 5th menu item. "

 +15                               SET GMPLTXT(2)="  Error: "_GMPLMSG("DIERR",1,"TEXT",1)

                                   SET GMPLERR=1

 +16                               DO BMES^XPDUTL(.GMPLTXT)

                               End DoDot:3

                       End DoDot:2

                       QUIT

               End DoDot:1

 +17       IF 'GMPLERR

               DO MES^XPDUTL("  Done.")

 +18       QUIT

 +19      ;

SENDARPT(GMPLULST,GMPLCLST,GMPLELST) ; Build pre-existing user/clinic selection list assignment rpt and send via MailMan

 +1        NEW GMPLTO,GMPLFROM,GMPXMSUB,SUB,GMPLCNT

 +2        KILL ^TMP("GMPLASGN",$JOB)

 +3        SET SUB="GMPLASGN"

           SET GMPLCNT=9

 +4        SET GMPXMSUB="Pre-existing USER/CLINIC Selection List Assignment Report"

 +5        SET GMPLFROM="GMPL*2.0*49 INSTALL"

 +6        SET GMPLTO(DUZ)=""

           SET GMPLTO("G.OR CACS")=""

 +7        SET ^TMP(SUB,$JOB,1,0)=""

 +8        SET ^TMP(SUB,$JOB,2,0)="This report was auto generated during installation to identify Problem"

 +9        SET ^TMP(SUB,$JOB,3,0)="Selection Lists assigned to users and clinics prior to the installation of"

 +10       SET ^TMP(SUB,$JOB,4,0)="GMPL*2.0*49. After installation all users and clinic assignments will be"

 +11       SET ^TMP(SUB,$JOB,5,0)="migrated to the new Default Selection List Display parameter setting. If users"

 +12       SET ^TMP(SUB,$JOB,6,0)="and clinics desire to use the National Problem Selection List as their default"

 +13       SET ^TMP(SUB,$JOB,7,0)="setting then use the Assign/Remove menu option to reassign those users or"

 +14       SET ^TMP(SUB,$JOB,8,0)="clinics listed in the report."

 +15       SET ^TMP(SUB,$JOB,9,0)=""

 +16       IF $DATA(GMPLULST)

               Begin DoDot:1

 +17               NEW GMPLUSR,GMPLST

                   SET (GMPLUSR,GMPLST)=""

 +18               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="User Selection List Assignments: "

 +19               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +20               FOR

                       SET GMPLUSR=$ORDER(GMPLULST(GMPLUSR))

                       if GMPLUSR=""

                           QUIT

                       Begin DoDot:2

 +21                       FOR

                               SET GMPLST=$ORDER(GMPLULST(GMPLUSR,GMPLST))

                               if GMPLST=""

                                   QUIT

                               Begin DoDot:3

 +22                               SET GMPLCNT=GMPLCNT+1

                                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="   "_$$LJ^XLFSTR(GMPLUSR,35)_$$LJ^XLFSTR(GMPLST,40)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +23      IF '$TEST

               SET GMPLCNT=GMPLCNT+1

               SET ^TMP(SUB,$JOB,GMPLCNT,0)="There are no USER selection list assignments in the system currently."

 +24       SET GMPLCNT=GMPLCNT+1

           SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +25       IF $DATA(GMPLCLST)

               Begin DoDot:1

 +26               NEW GMPLCLIN,GMPLLST

                   SET (GMPLCLIN,GMPLLST)=""

 +27               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="Clinic Selection List Assignments: "

 +28               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +29               FOR

                       SET GMPLCLIN=$ORDER(GMPLCLST(GMPLCLIN))

                       if GMPLCLIN=""

                           QUIT

                       Begin DoDot:2

 +30                       FOR

                               SET GMPLLST=$ORDER(GMPLCLST(GMPLCLIN,GMPLLST))

                               if GMPLLST=""

                                   QUIT

                               Begin DoDot:3

 +31                               SET GMPLCNT=GMPLCNT+1

                                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="   "_$$LJ^XLFSTR(GMPLCLIN,35)_$$LJ^XLFSTR(GMPLLST,40)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +32      IF '$TEST

               SET GMPLCNT=GMPLCNT+1

               SET ^TMP(SUB,$JOB,GMPLCNT,0)="There are no CLINIC selection list assignments in the system currently."

 +33       IF $DATA(GMPLELST)

               Begin DoDot:1

 +34               NEW GMPLUSNM,GMPLSLDA

                   SET (GMPLUSNM,GMPLSLDA)=""

 +35               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +36               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="User(s) assigned to a Selection List that no longer exists:"

 +37               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +38               FOR

                       SET GMPLUSNM=$ORDER(GMPLELST(GMPLUSNM))

                       if GMPLUSNM=""

                           QUIT

                       Begin DoDot:2

 +39                       FOR

                               SET GMPLSLDA=$ORDER(GMPLELST(GMPLUSNM,GMPLSLDA))

                               if GMPLSLDA=""

                                   QUIT

                               Begin DoDot:3

 +40                               SET GMPLCNT=GMPLCNT+1

                                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="   "_$$LJ^XLFSTR(GMPLUSNM,35)_$$LJ^XLFSTR("Selection List #"_GMPLSLDA,40)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +41       DO SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)

 +42       QUIT

 +43      ;

SENDCRPT(GMPLLIST,GMPLCAT) ; Build mix/lower case name report and send to installer via MailMan

 +1        NEW GMPLTO,GMPLFROM,GMPXMSUB,SUB,GMPLCNT,GMPLLNM,GMPLCNM

 +2        KILL ^TMP("GMPLCASE",$JOB)

 +3        SET SUB="GMPLCASE"

           SET GMPLCNT=9

           SET (GMPLLNM,GMPLCNM)=""

 +4        SET GMPXMSUB="Mixed & Lower Case List/Category Name Report"

 +5        SET GMPLFROM="GMPL*2.0*49 INSTALL"

 +6        SET GMPLTO(DUZ)=""

           SET GMPLTO("G.OR CACS")=""

 +7        SET ^TMP(SUB,$JOB,1,0)=""

 +8        SET ^TMP(SUB,$JOB,2,0)="Mixed/lower case problem selection list/category names are no longer allowed"

 +9        SET ^TMP(SUB,$JOB,3,0)="with patch GMPL*2.0*49. This patch scans the Problem Selection List and Problem"

 +10       SET ^TMP(SUB,$JOB,4,0)="Selection Category files for any names in mixed or lower case letters and"

 +11       SET ^TMP(SUB,$JOB,5,0)="converts them to upper case."

 +12       SET ^TMP(SUB,$JOB,6,0)=""

 +13       SET ^TMP(SUB,$JOB,7,0)="For those conversions that failed, please have a CAC or somebody with FileMan"

 +14       SET ^TMP(SUB,$JOB,8,0)="access manually modify the name to upper case."

 +15       SET ^TMP(SUB,$JOB,9,0)=""

 +16       IF $DATA(GMPLLIST("PASS"))

               Begin DoDot:1

 +17               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="The following list names converted successfully:"

 +18               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +19               FOR

                       SET GMPLLNM=$ORDER(GMPLLIST("PASS",GMPLLNM))

                       if GMPLLNM=""

                           QUIT

                       Begin DoDot:2

 +20                       SET GMPLCNT=GMPLCNT+1

                           SET ^TMP(SUB,$JOB,GMPLCNT,0)="     "_GMPLLNM

                       End DoDot:2

 +21               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

               End DoDot:1

 +22       IF $DATA(GMPLLIST("FAIL"))

               Begin DoDot:1

 +23               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="Failed list names:"

 +24               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

                   SET GMPLLNM=""

 +25               FOR

                       SET GMPLLNM=$ORDER(GMPLLIST("FAIL",GMPLLNM))

                       if GMPLLNM=""

                           QUIT

                       Begin DoDot:2

 +26                       SET GMPLCNT=GMPLCNT+1

                           SET ^TMP(SUB,$JOB,GMPLCNT,0)=$$LJ^XLFSTR("*"_GMPLLNM,34)_$$LJ^XLFSTR($PIECE(GMPLLIST("FAIL",GMPLLNM),U),18)_$$LJ^XLFSTR($PIECE(GMPLLIST("FAIL",GMPLLNM),U,2),80)

                       End DoDot:2

 +27               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

               End DoDot:1

 +28       IF $DATA(GMPLCAT("PASS"))

               Begin DoDot:1

 +29               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="The following category names converted successfully:"

 +30               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +31               FOR

                       SET GMPLCNM=$ORDER(GMPLCAT("PASS",GMPLCNM))

                       if GMPLCNM=""

                           QUIT

                       Begin DoDot:2

 +32                       SET GMPLCNT=GMPLCNT+1

                           SET ^TMP(SUB,$JOB,GMPLCNT,0)="     "_GMPLCNM

                       End DoDot:2

 +33               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

               End DoDot:1

 +34       IF $DATA(GMPLCAT("FAIL"))

               Begin DoDot:1

 +35               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="Failed category names:"

 +36               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

                   SET GMPLCNM=""

 +37               FOR

                       SET GMPLCNM=$ORDER(GMPLCAT("FAIL",GMPLCNM))

                       if GMPLCNM=""

                           QUIT

                       Begin DoDot:2

 +38                       SET GMPLCNT=GMPLCNT+1

                           SET ^TMP(SUB,$JOB,GMPLCNT,0)=$$LJ^XLFSTR("*"_GMPLCNM,34)_$$LJ^XLFSTR($PIECE(GMPLCAT("FAIL",GMPLCNM),U),18)_$$LJ^XLFSTR($PIECE(GMPLCAT("FAIL",GMPLCNM),U,2),80)

                       End DoDot:2

 +39               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

               End DoDot:1

 +40       DO SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)

 +41       QUIT

 +42      ;

SENDDRPT(GMPLDUPL,GMPLDUPC) ; Build duplicate name report and send to installer via MailMan

 +1        NEW GMPLTO,GMPLFROM,GMPXMSUB,SUB,GMPLCNT,GMPLLIST,GMPLCAT

 +2        KILL ^TMP("GMPLDUP",$JOB)

 +3        SET SUB="GMPLDUP"

           SET GMPLCNT=6

           SET (GMPLLIST,GMPLCAT)=""

 +4        SET GMPXMSUB="Duplicate Problem Selection List/Category Name Report"

 +5        SET GMPLFROM="GMPL*2.0*49 INSTALL"

 +6        SET GMPLTO(DUZ)=""

           SET GMPLTO("G.OR CACS")=""

 +7        SET ^TMP(SUB,$JOB,1,0)=""

 +8        SET ^TMP(SUB,$JOB,2,0)="Duplicate problem selection list/category names are no longer allowed with"

 +9        SET ^TMP(SUB,$JOB,3,0)="patch GMPL*2.0*49. The following list/category names are duplicates. Please"

 +10       SET ^TMP(SUB,$JOB,4,0)="have your CAC review these with the pre-existing file entries and rename,"

 +11       SET ^TMP(SUB,$JOB,5,0)="delete, or reconcile the duplicate entries as needed."

 +12       SET ^TMP(SUB,$JOB,6,0)=""

 +13       IF $DATA(GMPLDUPL)

               Begin DoDot:1

 +14               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="     Duplicate List Names:"

 +15               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +16               FOR

                       SET GMPLLIST=$ORDER(GMPLDUPL(GMPLLIST))

                       if GMPLLIST=""

                           QUIT

                       Begin DoDot:2

 +17                       SET GMPLCNT=GMPLCNT+1

                           SET ^TMP(SUB,$JOB,GMPLCNT,0)="     "_GMPLLIST

                       End DoDot:2

 +18               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

               End DoDot:1

 +19       IF $DATA(GMPLDUPC)

               Begin DoDot:1

 +20               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)="     Duplicate Category Names:"

 +21               SET GMPLCNT=GMPLCNT+1

                   SET ^TMP(SUB,$JOB,GMPLCNT,0)=""

 +22               FOR

                       SET GMPLCAT=$ORDER(GMPLDUPC(GMPLCAT))

                       if GMPLCAT=""

                           QUIT

                       Begin DoDot:2

 +23                       SET GMPLCNT=GMPLCNT+1

                           SET ^TMP(SUB,$JOB,GMPLCNT,0)="     "_GMPLCAT

                       End DoDot:2

               End DoDot:1

 +24       DO SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)

 +25       QUIT

 +26      ;

SENDLIST(GMPLSLST) ; Export national list/category data if prefixed with VA-

 +1        IF $EXTRACT(GMPLSLST,1,3)="VA-"

               QUIT 1

 +2        QUIT 0

 +3       ;

UPCHKMNU  ; Update GMPL SELECTION LIST CSV CHECK menu text

 +1        NEW GMPLIEN,GMPLFDA,GMPLMSG,GMPLERR,GMPLTXT

 +2        SET GMPLIEN=+$$FIND1^DIC(19,"","KX","GMPL SELECTION LIST CSV CHECK","","","GMPLMSG")

 +3        IF GMPLIEN>0

               Begin DoDot:1

 +4                DO BMES^XPDUTL("  Updating GMPL SELECTION LIST CSV CHECK menu text...")

 +5                SET GMPLFDA(19,""_GMPLIEN_",",1)="Check Problem Selection List Problem Codes"

 +6                DO FILE^DIE("EK","GMPLFDA","GMPLERR")

               End DoDot:1

 +7        IF $DATA(GMPLERR)

               Begin DoDot:1

 +8                SET GMPLTXT(1)="  Error updating menu text."

 +9                SET GMPLTXT(2)="  Error "_GMPLERR("DIERR",1)_": "_GMPLERR("DIERR",1,"TEXT",1)

 +10               DO BMES^XPDUTL(.GMPLTXT)

               End DoDot:1

 +11      IF '$TEST

               DO MES^XPDUTL("  Done.")

 +12       QUIT

 +13      ;

UPDTDORD  ; Update display order of several menu items for GMPL BUILD LIST MENU option

 +1        NEW GMPLI,GMPLOIEN,GMPLMSG,GMPLTXT,GMPLERR

           SET GMPLERR=0

 +2        SET GMPLOIEN=$$FIND1^DIC(19,"","BX","GMPL BUILD LIST MENU","","","GMPLMSG")

 +3        IF 'GMPLOIEN

               DO BMES^XPDUTL("  Error: Cannot find GMPL BUILD LIST MENU option")

               QUIT

 +4        FOR GMPLI=1:1:3

               Begin DoDot:1

 +5                NEW GMPLOPT,GMPLMIEN,GMPLIENS,GMPLVAL,GMPLFDA

 +6                SET GMPLOPT=$SELECT(GMPLI=1:"GMPL DELETE LIST",GMPLI=2:"GMPL SELECTION LIST CSV CHECK",1:"GMPL SELECTION LIST IMPORT")

 +7                SET GMPLVAL=$SELECT(GMPLI=1:"4",GMPLI=2:"5",1:"6")

 +8                SET GMPLMIEN=$$FIND1^DIC(19.01,","_GMPLOIEN_",","BX",GMPLOPT,"","","GMPLMSG")

 +9                SET GMPLIENS=""_GMPLMIEN_","_GMPLOIEN_","

 +10               SET GMPLFDA(19.01,GMPLIENS,2)=GMPLVAL

 +11               SET GMPLFDA(19.01,GMPLIENS,3)=GMPLVAL

 +12               DO FILE^DIE("EK","GMPLFDA","GMPLMSG")

 +13               IF $DATA(GMPLMSG)

                       Begin DoDot:2

 +14                       SET GMPLTXT(1)="  Menu Item: "_GMPLOPT

 +15                       SET GMPLTXT(2)="  Error: "_GMPLMSG("DIERR",1,"TEXT",1)

                           SET GMPLERR=1

 +16                       DO BMES^XPDUTL(.GMPLTXT)

                       End DoDot:2

               End DoDot:1

 +17       IF 'GMPLERR

               DO MES^XPDUTL("  Done.")

 +18       QUIT

 +19      ;

GMPLY49.m