Routine: GMRCYP42

GMRCYP42 ;ISP/TDP - PRE/POST INSTALL FOR GMRC*3*42; 3/9/2005

 ;;3.0;CONSULT/REQUEST TRACKING;**42**;DEC 27, 1997

ENV ;env check for service name conflict

 N GMRCMSG,GMRCSVC,I

 I $$PATCH^XPDUTL("GMRC*3.0*42") Q

 K ^TMP("GMRCYP42",$J)

 S GMRCSVC=0

 F  S GMRCSVC=$O(^GMR(123.5,GMRCSVC)) Q:'GMRCSVC  D

 . Q:'$D(^GMR(123.5,GMRCSVC,0))

 . D CHK1235($P(^GMR(123.5,GMRCSVC,0),U))

 I '$D(^TMP("GMRCYP42",$J)) D  Q

 . D BMES^XPDUTL("No conflicts with service being filed.")

 D WARNING(.GMRCMSG),MES^XPDUTL(.GMRCMSG)

 D BMES^XPDUTL(" ")

 S I=0 F  S I=$O(^TMP("GMRCYP42",$J,I)) Q:'I  D

 . D MES^XPDUTL(^TMP("GMRCYP42",$J,I,0))

 K ^TMP("GMRCYP42",$J)

CHK1235(SERVNM) ;check service name against exact or possible conflicts

 N X,Y

 S X=SERVNM

 X ^%ZOSF("UPPERCASE")

 I Y="CARE COORDINATION HOME TELEHEALTH SCREENING" D MSG(SERVNM,0) Q

 I Y["TELEHEALTH" D MSG(SERVNM,1) Q

 I Y["TELE HEALTH" D MSG(SERVNM,1) Q

MSG(TEXT,FLG) ;write install message if exact or partial match

 N MATCH,NEXT,MSG

 S MATCH=$S(+FLG:" partially ",1:" exactly ")

 S NEXT=$O(^TMP("GMRCYP42",$J,999),-1)+1

 S MSG=TEXT_MATCH_"matches the service being imported."

 S ^TMP("GMRCYP42",$J,NEXT,0)=MSG

WARNING(TXT) ;format warning statement for pre-install in case of conflicts

 S TXT(1)=$$FMTE^XLFDT($$NOW^XLFDT)

 S TXT(2)="This patch imports data for 1 service in the REQUEST SERVICES (#123.5) file."

 S TXT(3)="If the service does not exist in your file, it will be created as a new"

 S TXT(4)="entry. If the service does exist on your system, some fields of data will"

 S TXT(5)="be overwritten."

 ;S TXT(6)="(#1.01) PROVISIONAL DX PROMPT, (#1.02) PROVISIONAL DX INPUT, and "

 ;S TXT(7)="(#124) DEFAULT REASON FOR REQUEST. "

 S TXT(8)=" "

 S TXT(9)="Following this warning message, there will be one or more lines that "

 S TXT(10)="indicate that either an exact or partial match was found on your system."

 S TXT(11)="It is highly recommended that the install be aborted at this time until the"

 S TXT(12)="individual responsible for management of Consult/Request Tracking can "

 S TXT(13)="review and verify that these changes will not adversely affect operations"

 S TXT(14)="of the package."

PRE ; load service into REQUEST SERVICES (#123.5) file

 N I,SVC

 D BMES^XPDUTL("Adding CARE COORDINATION HOME TELEHEALTH SCREENING as a new consult")

 D MES^XPDUTL("   service in the REQUEST SERVICES (#123.5) file.")

 S SVC=$$FIND1^DIC(123.5,,"QX","CARE COORDINATION HOME TELEHEALTH SCREENING")

 I +SVC D EDIT(SVC)

 I '+SVC D ADD

 D BMES^XPDUTL("Pre-init complete.")

ADD ; add new REQUEST SERVICE

 N DEFAULT,DIC,DXI,DXP,INTERNAL,OERR,PRINT,PROTOCOL,X

 K DO

 S DIC="^GMR(123.5,"

 S DIC(0)="L"

 S X="CARE COORDINATION HOME TELEHEALTH SCREENING"

 S INTERNAL="CCHT SCREENING"

 S PRINT="CCHT SC"

 S DXP="O"

 S DXI="L"

 S DEFAULT="Initial Screening for Home Telehealth services."

 S PROTOCOL="GMRCACTM SERVICE ACTION MENU"

 S OERR="CONSULTS"

 S DIC("DR")="11////"_INTERNAL_";1.11////"_PRINT_";2////9;1.01////"_DXP_";1.02////"_DXI_";124///"_DEFAULT_";1.03////0;1.1///"_PRINT_"RN;123.03///"_PROTOCOL_";123.01///"_OERR

 D FILE^DICN

 I Y<0 D  Q

 . D BMES^XPDUTL("CARE COORDINATION HOME TELEHEALTH SCREENING failed to be added to the")

 . D MES^XPDUTL("   REQUEST SERVICES (#123.5) file.  Follow the instructions in the patch")

 . D MES^XPDUTL("   description for manually adding this service.")

K Y

EDIT(SVIEN) ; edit existing REQUEST SERVICE

 N DA,DEFAULT,DIE,DR,DXI,DXP,INTERNAL,OERR,PRINT,PROTOCOL,X

 K DO

 S DA=SVIEN

 S DIE="^GMR(123.5,"

 S INTERNAL="CCHT SCREENING"

 S PRINT="CCHT SC"

 S DXP="O"

 S DXI="L"

 S DEFAULT="Initial Screening for Home Telehealth services."

 S PROTOCOL="GMRCACTM SERVICE ACTION MENU"

 S OERR="CONSULTS"

 S DR="11////"_INTERNAL_";1.11////"_PRINT_";2////9;1.01////"_DXP_";1.02////"_DXI_";124///"_DEFAULT_";1.03////0;I $D(^GMR(123.5,DA,2,""B"",""CCHT SCRN"")) S Y=123.03;1.1////"_PRINT_"RN;123.03///"_PROTOCOL_";123.01///"_OERR

 D ^DIE

K Y

POST ; load services into SUB-SERVICE SPECIALTY of ALL SERVICES

 N SVC

 D BMES^XPDUTL("Adding CARE COORDINATION HOME TELEHEALTH SCREENING as a sub-service")

 D MES^XPDUTL("   to ALL SERVICES in the REQUEST SERVICES (#123.5) file.")

 S SVC=$$FIND1^DIC(123.5,,"QX","CARE COORDINATION HOME TELEHEALTH SCREENING") I +SVC D SUB(SVC)

 D BMES^XPDUTL("Post-init complete.")

SUB(SVIEN) ; add as sub of ALL SERVICES

 I $D(^GMR(123.5,"APC",SVIEN)) Q

 N DIC,DA,X

 K DO

 S DA(1)=1

 S DIC="^GMR(123.5,"_DA(1)_",10,"

 S DIC(0)="L"

 S X=SVIEN Q:'$L(X)

 D FILE^DICN

 I Y<0 D

 . D BMES^XPDUTL("CARE COORDINATION HOME TELEHEALTH SCREENING failed to be added as a")

 . D MES^XPDUTL("   sub-service to ALL SERVICES in the REQUEST SERVICES (#123.5) file.")

 . D MES^XPDUTL("   Follow the instructions in the patch description for manually adding")

 . D MES^XPDUTL("   this sub-service.")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCYP42   4933     printed  Apr 23, 2025@18:02:22                                                                                                                                                                                                    Page 2

GMRCYP42  ;ISP/TDP - PRE/POST INSTALL FOR GMRC*3*42; 3/9/2005

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**42**;DEC 27, 1997

ENV       ;env check for service name conflict

 +1        NEW GMRCMSG,GMRCSVC,I

 +2        IF $$PATCH^XPDUTL("GMRC*3.0*42")

               QUIT

 +3        KILL ^TMP("GMRCYP42",$JOB)

 +4        SET GMRCSVC=0

 +5        FOR

               SET GMRCSVC=$ORDER(^GMR(123.5,GMRCSVC))

               if 'GMRCSVC

                   QUIT

               Begin DoDot:1

 +6                if '$DATA(^GMR(123.5,GMRCSVC,0))

                       QUIT

 +7                DO CHK1235($PIECE(^GMR(123.5,GMRCSVC,0),U))

               End DoDot:1

 +8        IF '$DATA(^TMP("GMRCYP42",$JOB))

               Begin DoDot:1

 +9                DO BMES^XPDUTL("No conflicts with service being filed.")

               End DoDot:1

               QUIT

 +10       DO WARNING(.GMRCMSG)

           DO MES^XPDUTL(.GMRCMSG)

 +11       DO BMES^XPDUTL(" ")

 +12       SET I=0

FOR

               SET I=$ORDER(^TMP("GMRCYP42",$JOB,I))

               if 'I

                   QUIT

               Begin DoDot:1

 +13               DO MES^XPDUTL(^TMP("GMRCYP42",$JOB,I,0))

               End DoDot:1

 +14       KILL ^TMP("GMRCYP42",$JOB)

 +15       QUIT

CHK1235(SERVNM) ;check service name against exact or possible conflicts

 +1        NEW X,Y

 +2        SET X=SERVNM

 +3        XECUTE ^%ZOSF("UPPERCASE")

 +4        IF Y="CARE COORDINATION HOME TELEHEALTH SCREENING"

               DO MSG(SERVNM,0)

               QUIT

 +5        IF Y["TELEHEALTH"

               DO MSG(SERVNM,1)

               QUIT

 +6        IF Y["TELE HEALTH"

               DO MSG(SERVNM,1)

               QUIT

 +7        QUIT

MSG(TEXT,FLG) ;write install message if exact or partial match

 +1        NEW MATCH,NEXT,MSG

 +2        SET MATCH=$SELECT(+FLG:" partially ",1:" exactly ")

 +3        SET NEXT=$ORDER(^TMP("GMRCYP42",$JOB,999),-1)+1

 +4        SET MSG=TEXT_MATCH_"matches the service being imported."

 +5        SET ^TMP("GMRCYP42",$JOB,NEXT,0)=MSG

 +6        QUIT

WARNING(TXT) ;format warning statement for pre-install in case of conflicts

 +1        SET TXT(1)=$$FMTE^XLFDT($$NOW^XLFDT)

 +2        SET TXT(2)="This patch imports data for 1 service in the REQUEST SERVICES (#123.5) file."

 +3        SET TXT(3)="If the service does not exist in your file, it will be created as a new"

 +4        SET TXT(4)="entry. If the service does exist on your system, some fields of data will"

 +5        SET TXT(5)="be overwritten."

 +6       ;S TXT(6)="(#1.01) PROVISIONAL DX PROMPT, (#1.02) PROVISIONAL DX INPUT, and "

 +7       ;S TXT(7)="(#124) DEFAULT REASON FOR REQUEST. "

 +8        SET TXT(8)=" "

 +9        SET TXT(9)="Following this warning message, there will be one or more lines that "

 +10       SET TXT(10)="indicate that either an exact or partial match was found on your system."

 +11       SET TXT(11)="It is highly recommended that the install be aborted at this time until the"

 +12       SET TXT(12)="individual responsible for management of Consult/Request Tracking can "

 +13       SET TXT(13)="review and verify that these changes will not adversely affect operations"

 +14       SET TXT(14)="of the package."

 +15       QUIT

 +16      ;

PRE       ; load service into REQUEST SERVICES (#123.5) file

 +1        NEW I,SVC

 +2        DO BMES^XPDUTL("Adding CARE COORDINATION HOME TELEHEALTH SCREENING as a new consult")

 +3        DO MES^XPDUTL("   service in the REQUEST SERVICES (#123.5) file.")

 +4        SET SVC=$$FIND1^DIC(123.5,,"QX","CARE COORDINATION HOME TELEHEALTH SCREENING")

 +5        IF +SVC

               DO EDIT(SVC)

 +6        IF '+SVC

               DO ADD

 +7        DO BMES^XPDUTL("Pre-init complete.")

 +8        QUIT

ADD       ; add new REQUEST SERVICE

 +1        NEW DEFAULT,DIC,DXI,DXP,INTERNAL,OERR,PRINT,PROTOCOL,X

 +2        KILL DO

 +3        SET DIC="^GMR(123.5,"

 +4        SET DIC(0)="L"

 +5        SET X="CARE COORDINATION HOME TELEHEALTH SCREENING"

 +6        SET INTERNAL="CCHT SCREENING"

 +7        SET PRINT="CCHT SC"

 +8        SET DXP="O"

 +9        SET DXI="L"

 +10       SET DEFAULT="Initial Screening for Home Telehealth services."

 +11       SET PROTOCOL="GMRCACTM SERVICE ACTION MENU"

 +12       SET OERR="CONSULTS"

 +13       SET DIC("DR")="11////"_INTERNAL_";1.11////"_PRINT_";2////9;1.01////"_DXP_";1.02////"_DXI_";124///"_DEFAULT_";1.03////0;1.1///"_PRINT_"RN;123.03///"_PROTOCOL_";123.01///"_OERR

 +14       DO FILE^DICN

 +15       IF Y<0

               Begin DoDot:1

 +16               DO BMES^XPDUTL("CARE COORDINATION HOME TELEHEALTH SCREENING failed to be added to the")

 +17               DO MES^XPDUTL("   REQUEST SERVICES (#123.5) file.  Follow the instructions in the patch")

 +18               DO MES^XPDUTL("   description for manually adding this service.")

               End DoDot:1

               QUIT

 +19       KILL Y

 +20       QUIT

 +21      ;

EDIT(SVIEN) ; edit existing REQUEST SERVICE

 +1        NEW DA,DEFAULT,DIE,DR,DXI,DXP,INTERNAL,OERR,PRINT,PROTOCOL,X

 +2        KILL DO

 +3        SET DA=SVIEN

 +4        SET DIE="^GMR(123.5,"

 +5        SET INTERNAL="CCHT SCREENING"

 +6        SET PRINT="CCHT SC"

 +7        SET DXP="O"

 +8        SET DXI="L"

 +9        SET DEFAULT="Initial Screening for Home Telehealth services."

 +10       SET PROTOCOL="GMRCACTM SERVICE ACTION MENU"

 +11       SET OERR="CONSULTS"

 +12       SET DR="11////"_INTERNAL_";1.11////"_PRINT_";2////9;1.01////"_DXP_";1.02////"_DXI_";124///"_DEFAULT_";1.03////0;I $D(^GMR(123.5,DA,2,""B"",""CCHT SCRN"")) S Y=123.03;1.1////"_PRINT_"RN;123.03///"_PROTOCOL_";123.01///"_OERR

 +13       DO ^DIE

 +14       KILL Y

 +15       QUIT

 +16      ;

POST      ; load services into SUB-SERVICE SPECIALTY of ALL SERVICES

 +1        NEW SVC

 +2        DO BMES^XPDUTL("Adding CARE COORDINATION HOME TELEHEALTH SCREENING as a sub-service")

 +3        DO MES^XPDUTL("   to ALL SERVICES in the REQUEST SERVICES (#123.5) file.")

 +4        SET SVC=$$FIND1^DIC(123.5,,"QX","CARE COORDINATION HOME TELEHEALTH SCREENING")

           IF +SVC

               DO SUB(SVC)

 +5        DO BMES^XPDUTL("Post-init complete.")

 +6        QUIT

SUB(SVIEN) ; add as sub of ALL SERVICES

 +1        IF $DATA(^GMR(123.5,"APC",SVIEN))

               QUIT

 +2        NEW DIC,DA,X

 +3        KILL DO

 +4        SET DA(1)=1

 +5        SET DIC="^GMR(123.5,"_DA(1)_",10,"

 +6        SET DIC(0)="L"

 +7        SET X=SVIEN

           if '$LENGTH(X)

               QUIT

 +8        DO FILE^DICN

 +9        IF Y<0

               Begin DoDot:1

 +10               DO BMES^XPDUTL("CARE COORDINATION HOME TELEHEALTH SCREENING failed to be added as a")

 +11               DO MES^XPDUTL("   sub-service to ALL SERVICES in the REQUEST SERVICES (#123.5) file.")

 +12               DO MES^XPDUTL("   Follow the instructions in the patch description for manually adding")

 +13               DO MES^XPDUTL("   this sub-service.")

               End DoDot:1

 +14       QUIT

GMRCYP42.m