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)
Q
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
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
Q
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."
Q
;
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.")
Q
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
Q
;
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
Q
;
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.")
Q
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.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCYP42 4933 printed Dec 13, 2024@01:47:56 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
