PXRMP19I ; BP/AGP/WAT - PXRM*2.0*19 INSTALL ROUTINE. ;02/27/17 13:27
;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187
Q
;2053 UPDATE^DIE | 3217 $$FIND1^DIC | 2056 $$GET1^DIQ | 10103 $$FMADD^XLFDT| 10067 DES^XMA21 | 5249 ^TIU(8925.1
;5247 ^GMT(142 | 10141 ^XPDUTL | 4440 PROD^XUPROD | 2541 KSP^XUPARAM | 1131 ^XMB("NETNAME") | 10067 DES^XMA21 | 2172 XPDID
;
PRE ;
N INC
I $D(^XTMP("PXRM CCHT_HT")) S INC=(+$O(^XTMP("PXRM CCHT_HT",1000000000),-1)+1)
E S INC=1
S ^XTMP("PXRM CCHT_HT",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^"_"CONTAINS ANY ITEMS RENAMED BY PXRM*2.0*19"
N P47I
S P47I=$$PATCH^XPDUTL("PXRM*2.0*47")
I 'P47I D
. D OPTION^PXRMUTIL("DISABLE")
. D PROTOCOL^PXRMUTIL("DISABLE")
I P47I D
. D OPTIONS^PXRMUTIL("DISABLE","INSTALL OF PXRM*2.0*19")
. D PROTCOLS^PXRMUTIL("DISABLE","INSTALL OF PXRM*2.0*19")
D HFACTOR^PXRMP19B
D EDTOPICS
D INSTUB
D DELEXE^PXRMEXSI("EXARRAY","PXRMP19E")
Q
;
POST ;
K:$D(^XTMP("PXRM19RECIPS")) ^XTMP("PXRM19RECIPS")
N XPDIDTOT,PXRMNUM,PXRMPOST,OUTPUT
N XMDUZ,XMDF,XMMG,X,XMOUT,XMY,DIR,NXT
S XPDIDTOT=6,PXRMNUM=1,PXRMPOST=1
S OUTPUT(1)="The post-install will generate a single MailMan message:"
S OUTPUT(2)="LOCAL CCHT HFs NOT USED IN NAT'L HT CLIN REMINDER CONTENT"
S OUTPUT(3)="The installer is strongly encouraged to include the site's local Clinical"
S OUTPUT(4)="Reminders support/configuration personnel/mail group as recipients."
;Enable options and protocols
N P47I
S P47I=$$PATCH^XPDUTL("PXRM*2.0*47")
I 'P47I D
. D OPTION^PXRMUTIL("ENABLE")
. D PROTOCOL^PXRMUTIL("ENABLE")
I P47I D
. D OPTIONS^PXRMUTIL("ENABLE","INSTALL OF PXRM*2.0*19")
. D PROTCOLS^PXRMUTIL("ENABLE","INSTALL OF PXRM*2.0*19")
D BMES^XPDUTL("Preparing to install Reminder Exchange entry VA-HT PROJECT.")
D MES^XPDUTL("This is a very large entry that installs numerous components.")
D MES^XPDUTL("Installation of this entry will take 10-15 minutes.")
D SMEXINS^PXRMEXSI("EXARRAY","PXRMP19E")
D UPDATE
D BMES^XPDUTL(.OUTPUT)
S XMDUZ=DUZ
D DES^XMA21
I $D(XMY)>9 D
.S ^XTMP("PXRM19RECIPS",0)=$$FMADD^XLFDT(DT,31)_U_DT_U_"RECIPIENTS OF PXRM*2.0*19 POST INSTALL MESSAGES"
.M ^XTMP("PXRM19RECIPS")=XMY
D QUEUE^PXRMP19A("post-install message","MAIN^PXRMP19A","PXRM*2.0*19 HT MAILMAM REPORT",.PXRMNUM)
D ORWPCE^PXRMP19A(.PXRMNUM)
D TIURMDLG^PXRMP19A(.PXRMNUM)
D SETTIU
D SENDIM
Q
;
UPDATE ;update progress bar during post-install
I $G(PXRMPOST)=1 D UPDATE^XPDID(PXRMNUM) S PXRMNUM=PXRMNUM+1
Q
;
SETTIU ;set tiu obj class owner
;;HT CAREGIVER
;;HT CATEGORY OF CARE
;;HT EMERGENCY PRIORITY RATING
;;HT ENROLLMENT START DATE
;;HT MED RECON
;;HT NIC/CCM RATING LAST
;;HT REMINDERS DUE
;;ADMISSIONS PAST YR
;;GEC BASIC ADLS (LAST)
;;GEC IADLS (LAST)
;;OUTPT APPTS PAST YR
;;NEXT OF KIN
;;EOF
D MES^XPDUTL("Setting Data Fields for TIU-HS Objects")
N FDA,FDAIEN,ERRMSG,MSG,OBJIEN,HSI,HSTYPE,NAME,OWNER,PXRMERR
S HSI=""
S OWNER=$$LU(8930,"CLINICAL COORDINATOR")
S FDAIEN="?1"
F HSI=1:1 S HSTYPE=$P($T(SETTIU+HSI),";",3) Q:HSTYPE="EOF" D
.N FDA
.S NAME=$P($T(SETTIU+HSI),";;",2)
.S OBJIEN=$$LU(8925.1,NAME)
.I $G(OBJIEN)=0 D BMES^XPDUTL(NAME_" not found in TIU DOCUMENT DEFINITION file") Q
.I $G(OBJIEN)="" S ERRMSG="Error during lookup. The error returned was:" D ERR(ERRMSG,.PXRMERR) Q
.Q:$P(^TIU(8925.1,$G(OBJIEN),0),U,4)'="O"
.S FDA(8925.1,OBJIEN_",",.06)=$G(OWNER)
.S FDA(8925.1,OBJIEN_",",.13)="YES"
.S FDA(8925.1,OBJIEN_",",99)=$H
.D UPDATE^DIE("","FDA","","MSG")
.I $D(MSG("DIERR")) S ERRMSG="Error setting data..." D ERR(ERRMSG,.MSG) Q
D BMES^XPDUTL("Setting Data Fields Complete")
D UPDATE
Q
;
ERR(ERRMSG,MSG) ; error
I $D(MSG) D Q
.D BMES^XPDUTL($G(ERRMSG))
.S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
Q
;
LU(FILE,NAME) ; DBS lookup
Q $$FIND1^DIC(FILE,"","X",NAME,,,"PXRMERR")
;
SENDIM ;Send install message.
N FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
S NODE="PXRM*2.0*19"
K ^TMP(NODE,$J)
S FROM="PXRM*2.0*19 Install@"_^XMB("NETNAME")
S SYSTEM=$$KSP^XUPARAM("WHERE")
I $$PROD^XUPROD(1) S TO("G.CLINICAL REMINDERS SUPPORT@DOMAIN.EXT")=""
E D
. N MGIEN,MGROUP
. S MGIEN=$G(^PXRM(800,1,"MGFE"))
. S MGROUP=$S(MGIEN'="":"G."_$$GET1^DIQ(3.8,MGIEN,.01),1:DUZ)
. S TO(MGROUP)=""
S SUBJECT="Install of PXRM*2.0*19"
S ^TMP(NODE,$J,1,0)="PXRM*2.0*19 has been installed."
S ^TMP(NODE,$J,2,0)="System is "_SYSTEM
D SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
D UPDATE
Q
;
EDTOPICS ;
;if low IEN at pilot site; rename to VA- to avoid two entries at low IENs with different names
N LIST,PXNAT,PXRMINST,FILENUM,NAME,DA,MSG,NEWNAME
D EDLIST(.LIST)
S PXNAT=1
S FILENUM="" F S FILENUM=$O(LIST(FILENUM)) Q:FILENUM="" D
.S NAME="" F S NAME=$O(LIST(FILENUM,NAME)) Q:NAME="" D
..S DA=$$FIND1^DIC(FILENUM,"","BX",NAME,"","","MSG") Q:DA=0 ;don't proceed if item not found.
..I $D(MSG("DIERR")) D Q
...D BMES^XPDUTL("Error during lookup of "_NAME)
...S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
..Q:DA'<100000 ;if the IEN is high/local, leave entry as is and pilot site will have to manually delete/repoint to new VA- nat'l entry
..I NAME="CARE COORDINATION HOME TELEHEALTH (CCHT)" S NEWNAME="VA-HOME TELEHEALTH (HT)" D RENAME^PXRMUTIL(FILENUM,NAME,NEWNAME) Q
..S NEWNAME="VA-"_NAME D RENAME^PXRMUTIL(FILENUM,NAME,NEWNAME)
..S ^XTMP("PXRM CCHT_HT",INC,0)=FILENUM_"^"_NAME_"^"_NEWNAME,INC=INC+1
Q
;
EDLIST(LIST) ;list of ed topics
S LIST(9999999.09,"CARE COORDINATION HOME TELEHEALTH (CCHT)")=""
S LIST(9999999.09,"HOME TELEHEALTH-DISEASE MGMT/PATIENT SELF-MGMT")=""
S LIST(9999999.09,"HOME TELEHEALTH-IN HOME MONITORING")=""
S LIST(9999999.09,"HOME TELEHEALTH-CAREGIVER EDUCATION/SUPPORT")=""
S LIST(9999999.09,"HOME TELEHEALTH-MEDICATION MANAGEMENT")=""
Q
;
INSTUB ;stubs for non-remote types
;;VA-ADMISSIONS PAST YR
;;VA-GEC IADLS
;;VA-GEC BASIC ADLS
;;VA-HT BASIC ADLS
;;VA-HT CAREGIVER
;;VA-HT CATEGORY OF CARE LAST
;;VA-HT EMERGENCY LEVELS LAST
;;VA-HT ENROLLMENT START
;;VA-HT IADLS
;;VA-HT MED RECON
;;VA-HT NIC/CCM RATING LAST
;;VA-HT REMINDERS DUE
;;VA-NEXT OF KIN
;;VA-OUTPT APPTS PAST YR
;;EOF
N DA,DIE,DR,IEN,LIEN,NAME
N HSTYPE,HSI
N FDA,MSG,HSIEN
S HSI=""
S DIE="^GMT(142,"
F HSI=1:1 S HSTYPE=$P($T(INSTUB+HSI),";",3) Q:HSTYPE="EOF" D
.;if type already exists, quit out for this type
.Q:$D(^GMT(142,"B",HSTYPE))>0
.S IEN=0 F S IEN=$O(^GMT(142,IEN)) D Q:IEN'>0!(IEN=5000001)
..I IEN<5000000 S LIEN=IEN
.I LIEN<5000000 D
..S DA=LIEN
..Q:DA=5000000
..S DA=DA+1
..I '$D(^GMT(142,DA)) D
...S FDA(1,142,"+1,",.01)=HSTYPE
...S HSIEN(1)=DA
...D UPDATE^DIE("S","FDA(1)","HSIEN","MSG")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP19I 6833 printed Dec 13, 2024@01:47:13 Page 2
PXRMP19I ; BP/AGP/WAT - PXRM*2.0*19 INSTALL ROUTINE. ;02/27/17 13:27
+1 ;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187
+2 QUIT
+3 ;2053 UPDATE^DIE | 3217 $$FIND1^DIC | 2056 $$GET1^DIQ | 10103 $$FMADD^XLFDT| 10067 DES^XMA21 | 5249 ^TIU(8925.1
+4 ;5247 ^GMT(142 | 10141 ^XPDUTL | 4440 PROD^XUPROD | 2541 KSP^XUPARAM | 1131 ^XMB("NETNAME") | 10067 DES^XMA21 | 2172 XPDID
+5 ;
PRE ;
+1 NEW INC
+2 IF $DATA(^XTMP("PXRM CCHT_HT"))
SET INC=(+$ORDER(^XTMP("PXRM CCHT_HT",1000000000),-1)+1)
+3 IF '$TEST
SET INC=1
+4 SET ^XTMP("PXRM CCHT_HT",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^"_"CONTAINS ANY ITEMS RENAMED BY PXRM*2.0*19"
+5 NEW P47I
+6 SET P47I=$$PATCH^XPDUTL("PXRM*2.0*47")
+7 IF 'P47I
Begin DoDot:1
+8 DO OPTION^PXRMUTIL("DISABLE")
+9 DO PROTOCOL^PXRMUTIL("DISABLE")
End DoDot:1
+10 IF P47I
Begin DoDot:1
+11 DO OPTIONS^PXRMUTIL("DISABLE","INSTALL OF PXRM*2.0*19")
+12 DO PROTCOLS^PXRMUTIL("DISABLE","INSTALL OF PXRM*2.0*19")
End DoDot:1
+13 DO HFACTOR^PXRMP19B
+14 DO EDTOPICS
+15 DO INSTUB
+16 DO DELEXE^PXRMEXSI("EXARRAY","PXRMP19E")
+17 QUIT
+18 ;
POST ;
+1 if $DATA(^XTMP("PXRM19RECIPS"))
KILL ^XTMP("PXRM19RECIPS")
+2 NEW XPDIDTOT,PXRMNUM,PXRMPOST,OUTPUT
+3 NEW XMDUZ,XMDF,XMMG,X,XMOUT,XMY,DIR,NXT
+4 SET XPDIDTOT=6
SET PXRMNUM=1
SET PXRMPOST=1
+5 SET OUTPUT(1)="The post-install will generate a single MailMan message:"
+6 SET OUTPUT(2)="LOCAL CCHT HFs NOT USED IN NAT'L HT CLIN REMINDER CONTENT"
+7 SET OUTPUT(3)="The installer is strongly encouraged to include the site's local Clinical"
+8 SET OUTPUT(4)="Reminders support/configuration personnel/mail group as recipients."
+9 ;Enable options and protocols
+10 NEW P47I
+11 SET P47I=$$PATCH^XPDUTL("PXRM*2.0*47")
+12 IF 'P47I
Begin DoDot:1
+13 DO OPTION^PXRMUTIL("ENABLE")
+14 DO PROTOCOL^PXRMUTIL("ENABLE")
End DoDot:1
+15 IF P47I
Begin DoDot:1
+16 DO OPTIONS^PXRMUTIL("ENABLE","INSTALL OF PXRM*2.0*19")
+17 DO PROTCOLS^PXRMUTIL("ENABLE","INSTALL OF PXRM*2.0*19")
End DoDot:1
+18 DO BMES^XPDUTL("Preparing to install Reminder Exchange entry VA-HT PROJECT.")
+19 DO MES^XPDUTL("This is a very large entry that installs numerous components.")
+20 DO MES^XPDUTL("Installation of this entry will take 10-15 minutes.")
+21 DO SMEXINS^PXRMEXSI("EXARRAY","PXRMP19E")
+22 DO UPDATE
+23 DO BMES^XPDUTL(.OUTPUT)
+24 SET XMDUZ=DUZ
+25 DO DES^XMA21
+26 IF $DATA(XMY)>9
Begin DoDot:1
+27 SET ^XTMP("PXRM19RECIPS",0)=$$FMADD^XLFDT(DT,31)_U_DT_U_"RECIPIENTS OF PXRM*2.0*19 POST INSTALL MESSAGES"
+28 MERGE ^XTMP("PXRM19RECIPS")=XMY
End DoDot:1
+29 DO QUEUE^PXRMP19A("post-install message","MAIN^PXRMP19A","PXRM*2.0*19 HT MAILMAM REPORT",.PXRMNUM)
+30 DO ORWPCE^PXRMP19A(.PXRMNUM)
+31 DO TIURMDLG^PXRMP19A(.PXRMNUM)
+32 DO SETTIU
+33 DO SENDIM
+34 QUIT
+35 ;
UPDATE ;update progress bar during post-install
+1 IF $GET(PXRMPOST)=1
DO UPDATE^XPDID(PXRMNUM)
SET PXRMNUM=PXRMNUM+1
+2 QUIT
+3 ;
SETTIU ;set tiu obj class owner
+1 ;;HT CAREGIVER
+2 ;;HT CATEGORY OF CARE
+3 ;;HT EMERGENCY PRIORITY RATING
+4 ;;HT ENROLLMENT START DATE
+5 ;;HT MED RECON
+6 ;;HT NIC/CCM RATING LAST
+7 ;;HT REMINDERS DUE
+8 ;;ADMISSIONS PAST YR
+9 ;;GEC BASIC ADLS (LAST)
+10 ;;GEC IADLS (LAST)
+11 ;;OUTPT APPTS PAST YR
+12 ;;NEXT OF KIN
+13 ;;EOF
+14 DO MES^XPDUTL("Setting Data Fields for TIU-HS Objects")
+15 NEW FDA,FDAIEN,ERRMSG,MSG,OBJIEN,HSI,HSTYPE,NAME,OWNER,PXRMERR
+16 SET HSI=""
+17 SET OWNER=$$LU(8930,"CLINICAL COORDINATOR")
+18 SET FDAIEN="?1"
+19 FOR HSI=1:1
SET HSTYPE=$PIECE($TEXT(SETTIU+HSI),";",3)
if HSTYPE="EOF"
QUIT
Begin DoDot:1
+20 NEW FDA
+21 SET NAME=$PIECE($TEXT(SETTIU+HSI),";;",2)
+22 SET OBJIEN=$$LU(8925.1,NAME)
+23 IF $GET(OBJIEN)=0
DO BMES^XPDUTL(NAME_" not found in TIU DOCUMENT DEFINITION file")
QUIT
+24 IF $GET(OBJIEN)=""
SET ERRMSG="Error during lookup. The error returned was:"
DO ERR(ERRMSG,.PXRMERR)
QUIT
+25 if $PIECE(^TIU(8925.1,$GET(OBJIEN),0),U,4)'="O"
QUIT
+26 SET FDA(8925.1,OBJIEN_",",.06)=$GET(OWNER)
+27 SET FDA(8925.1,OBJIEN_",",.13)="YES"
+28 SET FDA(8925.1,OBJIEN_",",99)=$HOROLOG
+29 DO UPDATE^DIE("","FDA","","MSG")
+30 IF $DATA(MSG("DIERR"))
SET ERRMSG="Error setting data..."
DO ERR(ERRMSG,.MSG)
QUIT
End DoDot:1
+31 DO BMES^XPDUTL("Setting Data Fields Complete")
+32 DO UPDATE
+33 QUIT
+34 ;
ERR(ERRMSG,MSG) ; error
+1 IF $DATA(MSG)
Begin DoDot:1
+2 DO BMES^XPDUTL($GET(ERRMSG))
+3 SET MSG=""
FOR
SET MSG=$ORDER(MSG("DIERR",1,"TEXT",MSG))
if MSG=""
QUIT
WRITE MSG("DIERR",1,"TEXT",MSG),!
End DoDot:1
QUIT
+4 QUIT
+5 ;
LU(FILE,NAME) ; DBS lookup
+1 QUIT $$FIND1^DIC(FILE,"","X",NAME,,,"PXRMERR")
+2 ;
SENDIM ;Send install message.
+1 NEW FROM,NODE,PARAM,SYSTEM,SUBJECT,TO,VALUE
+2 SET NODE="PXRM*2.0*19"
+3 KILL ^TMP(NODE,$JOB)
+4 SET FROM="PXRM*2.0*19 Install@"_^XMB("NETNAME")
+5 SET SYSTEM=$$KSP^XUPARAM("WHERE")
+6 IF $$PROD^XUPROD(1)
SET TO("G.CLINICAL REMINDERS SUPPORT@DOMAIN.EXT")=""
+7 IF '$TEST
Begin DoDot:1
+8 NEW MGIEN,MGROUP
+9 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+10 SET MGROUP=$SELECT(MGIEN'="":"G."_$$GET1^DIQ(3.8,MGIEN,.01),1:DUZ)
+11 SET TO(MGROUP)=""
End DoDot:1
+12 SET SUBJECT="Install of PXRM*2.0*19"
+13 SET ^TMP(NODE,$JOB,1,0)="PXRM*2.0*19 has been installed."
+14 SET ^TMP(NODE,$JOB,2,0)="System is "_SYSTEM
+15 DO SEND^PXRMMSG(NODE,SUBJECT,.TO,FROM)
+16 DO UPDATE
+17 QUIT
+18 ;
EDTOPICS ;
+1 ;if low IEN at pilot site; rename to VA- to avoid two entries at low IENs with different names
+2 NEW LIST,PXNAT,PXRMINST,FILENUM,NAME,DA,MSG,NEWNAME
+3 DO EDLIST(.LIST)
+4 SET PXNAT=1
+5 SET FILENUM=""
FOR
SET FILENUM=$ORDER(LIST(FILENUM))
if FILENUM=""
QUIT
Begin DoDot:1
+6 SET NAME=""
FOR
SET NAME=$ORDER(LIST(FILENUM,NAME))
if NAME=""
QUIT
Begin DoDot:2
+7 ;don't proceed if item not found.
SET DA=$$FIND1^DIC(FILENUM,"","BX",NAME,"","","MSG")
if DA=0
QUIT
+8 IF $DATA(MSG("DIERR"))
Begin DoDot:3
+9 DO BMES^XPDUTL("Error during lookup of "_NAME)
+10 SET MSG=""
FOR
SET MSG=$ORDER(MSG("DIERR",1,"TEXT",MSG))
if MSG=""
QUIT
WRITE MSG("DIERR",1,"TEXT",MSG),!
End DoDot:3
QUIT
+11 ;if the IEN is high/local, leave entry as is and pilot site will have to manually delete/repoint to new VA- nat'l entry
if DA'<100000
QUIT
+12 IF NAME="CARE COORDINATION HOME TELEHEALTH (CCHT)"
SET NEWNAME="VA-HOME TELEHEALTH (HT)"
DO RENAME^PXRMUTIL(FILENUM,NAME,NEWNAME)
QUIT
+13 SET NEWNAME="VA-"_NAME
DO RENAME^PXRMUTIL(FILENUM,NAME,NEWNAME)
+14 SET ^XTMP("PXRM CCHT_HT",INC,0)=FILENUM_"^"_NAME_"^"_NEWNAME
SET INC=INC+1
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
EDLIST(LIST) ;list of ed topics
+1 SET LIST(9999999.09,"CARE COORDINATION HOME TELEHEALTH (CCHT)")=""
+2 SET LIST(9999999.09,"HOME TELEHEALTH-DISEASE MGMT/PATIENT SELF-MGMT")=""
+3 SET LIST(9999999.09,"HOME TELEHEALTH-IN HOME MONITORING")=""
+4 SET LIST(9999999.09,"HOME TELEHEALTH-CAREGIVER EDUCATION/SUPPORT")=""
+5 SET LIST(9999999.09,"HOME TELEHEALTH-MEDICATION MANAGEMENT")=""
+6 QUIT
+7 ;
INSTUB ;stubs for non-remote types
+1 ;;VA-ADMISSIONS PAST YR
+2 ;;VA-GEC IADLS
+3 ;;VA-GEC BASIC ADLS
+4 ;;VA-HT BASIC ADLS
+5 ;;VA-HT CAREGIVER
+6 ;;VA-HT CATEGORY OF CARE LAST
+7 ;;VA-HT EMERGENCY LEVELS LAST
+8 ;;VA-HT ENROLLMENT START
+9 ;;VA-HT IADLS
+10 ;;VA-HT MED RECON
+11 ;;VA-HT NIC/CCM RATING LAST
+12 ;;VA-HT REMINDERS DUE
+13 ;;VA-NEXT OF KIN
+14 ;;VA-OUTPT APPTS PAST YR
+15 ;;EOF
+16 NEW DA,DIE,DR,IEN,LIEN,NAME
+17 NEW HSTYPE,HSI
+18 NEW FDA,MSG,HSIEN
+19 SET HSI=""
+20 SET DIE="^GMT(142,"
+21 FOR HSI=1:1
SET HSTYPE=$PIECE($TEXT(INSTUB+HSI),";",3)
if HSTYPE="EOF"
QUIT
Begin DoDot:1
+22 ;if type already exists, quit out for this type
+23 if $DATA(^GMT(142,"B",HSTYPE))>0
QUIT
+24 SET IEN=0
FOR
SET IEN=$ORDER(^GMT(142,IEN))
Begin DoDot:2
+25 IF IEN<5000000
SET LIEN=IEN
End DoDot:2
if IEN'>0!(IEN=5000001)
QUIT
+26 IF LIEN<5000000
Begin DoDot:2
+27 SET DA=LIEN
+28 if DA=5000000
QUIT
+29 SET DA=DA+1
+30 IF '$DATA(^GMT(142,DA))
Begin DoDot:3
+31 SET FDA(1,142,"+1,",.01)=HSTYPE
+32 SET HSIEN(1)=DA
+33 DO UPDATE^DIE("S","FDA(1)","HSIEN","MSG")
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
