- 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 Feb 18, 2025@23:13:35 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 ;