- GMTSXPD6 ;ISP/RFR - Health Summary Dist (Type & Objects) ;Jun 22, 2023@18:36
- ;;2.7;Health Summary;**144**;Oct 20, 1995;Build 17
- Q
- INSDATA(GMTSTAG,GMTSRTN) ; Install/Update Health Summary File Entry
- ; PARAMETERS: GMTSTAG - TAG CONTAINING TEXT THAT DEFINES FILE ENTRY
- ; GMTSRTN - ROUTINE THAT CONTAINS GMTSTAG
- N GMTSPARENT,GMTSLINE,GMTSTXT,GMTSFILE,GMTSFIELD,GMTSVALUE,GMTSERROR
- N GMTSDATA,GMTSIEN,GMTSIENS,GMTSSIENS,GMTSFDA,GMTSMESSAGE,GMTSROOT
- N GMTSLOC,GMTSTYPE,GMTSWPLINE,GMTSWPDATA,GMTSWP,GMTSADDL,GMTSNAME,GMTSPFILE
- S GMTSPARENT(142.01)=142,GMTSPARENT(142.2)=142,GMTSPARENT(142.14)=142.01
- S GMTSADDL(142,99)="S GMTSDATA(GMTSFILE,99)=$H"
- S GMTSADDL(142.5,"IEN")="S GMTSDATA(GMTSFILE,""IEN"")=$$GETOBJIEN^GMTSXPD6(GMTSDATA(GMTSFILE,.01))"
- S GMTSADDL(142.5,.18)="S GMTSDATA(GMTSFILE,.18)=$$NOW^XLFDT"
- S GMTSADDL(142.5,.2)="S GMTSDATA(GMTSFILE,.2)=""YES"""
- F GMTSLINE=1:1 D Q:GMTSTXT=""
- .S GMTSLOC=GMTSTAG_"+"_GMTSLINE_U_GMTSRTN
- .S GMTSTXT=$P($T(@(GMTSLOC)),";;",2)
- .Q:GMTSTXT=""
- .S GMTSFILE=$P(GMTSTXT,";",1),GMTSFIELD=$P(GMTSTXT,";",2)
- .S GMTSVALUE=$P(GMTSTXT,";",3)
- .I GMTSFILE=""!(GMTSFIELD="") D Q
- ..D MES^XPDUTL(" Invalid data definition at "_GMTSLOC)
- ..S GMTSTXT="",GMTSERROR=1
- .I '$D(GMTSTYPE(GMTSFILE,GMTSFIELD)) D
- ..S GMTSTYPE(GMTSFILE,GMTSFIELD)=$$GET1^DID(GMTSFILE,GMTSFIELD,,"TYPE",,"GMTSERROR")
- .I $G(GMTSTYPE(GMTSFILE))="",'$D(GMTSPARENT(GMTSFILE)) D
- ..S GMTSNAME=$$LOW^XLFSTR($$GET1^DID(GMTSFILE,,,"NAME",,"GMTSERROR"))
- ..S GMTSNAME=$P(GMTSNAME,"health summary ",2)
- ..I $E(GMTSNAME,*)="s" S GMTSNAME=$E(GMTSNAME,1,*-1)
- ..S GMTSTYPE(GMTSFILE)=GMTSNAME
- .I GMTSTYPE(GMTSFILE,GMTSFIELD)="WORD-PROCESSING" D
- ..S GMTSWPLINE=1+$O(GMTSWPDATA(GMTSFILE,GMTSFIELD,"?"),-1)
- ..S GMTSWPDATA(GMTSFILE,GMTSFIELD,GMTSWPLINE,0)=GMTSVALUE
- .E S GMTSDATA(GMTSFILE,GMTSFIELD)=GMTSVALUE
- Q:$D(GMTSERROR) 0
- S GMTSFILE=0
- F S GMTSFILE=$O(GMTSDATA(GMTSFILE)) Q:'+GMTSFILE!($D(GMTSERROR)) D
- .I $G(GMTSDATA(GMTSFILE,.01))="" D Q
- ..D MES^XPDUTL(" Invalid data definition: file #"_GMTSFILE_" has no .01 field")
- ..S GMTSERROR=1
- .I $D(GMTSPARENT(GMTSFILE)),'$D(GMTSIENS(GMTSPARENT(GMTSFILE))) D Q
- ..D MES^XPDUTL(" Invalid data definition: sub-file #"_GMTSFILE_" has no parent file #"_GMTSPARENT(GMTSFILE)_" definition")
- ..S GMTSERROR=1
- .S GMTSFIELD=0 F S GMTSFIELD=$O(GMTSADDL(GMTSFILE,GMTSFIELD)) Q:GMTSFIELD="" D
- ..X GMTSADDL(GMTSFILE,GMTSFIELD)
- .I '$D(GMTSPARENT(GMTSFILE)) D Q:$D(GMTSERROR)
- ..I +$G(GMTSDATA(GMTSFILE,"IEN"))=0 D
- ...S GMTSSIENS=+$$FIND1^DIC(GMTSFILE,,"X",GMTSDATA(GMTSFILE,.01),,,"GMTSERROR")
- ..I +$G(GMTSDATA(GMTSFILE,"IEN"))>0 D Q:$D(GMTSERROR)
- ...S GMTSIEN(1)=+GMTSDATA(GMTSFILE,"IEN")
- ...K GMTSDATA(GMTSFILE,"IEN")
- ...S GMTSROOT=$$GET1^DID(GMTSFILE,,,"GLOBAL NAME",,"GMTSERROR")
- ...I $D(GMTSERROR) D Q
- ....D MSG^DIALOG("WE",.GMTSMESSAGE,($G(IOM,80)-7),,"GMTSERROR")
- ....D MES^XPDUTL(" Filing error:")
- ....F GMTSLINE=1:1:GMTSMESSAGE D
- .....D MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
- ...S GMTSROOT=GMTSROOT_GMTSIEN(1)_")"
- ...S GMTSSIENS=$S($D(@GMTSROOT):GMTSIEN(1),1:0)
- ..I GMTSSIENS>0 D
- ...S GMTSFDA(GMTSFILE,GMTSSIENS_",",.01)="@"
- ...D FILE^DIE("E","GMTSFDA","GMTSERROR")
- ...I $D(GMTSERROR) D
- ....D MSG^DIALOG("WE",.GMTSMESSAGE,($G(IOM,80)-7),,"GMTSERROR")
- ....D MES^XPDUTL(" Filing error:")
- ....F GMTSLINE=1:1:GMTSMESSAGE D
- .....D MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
- ...S GMTSIEN(1)=GMTSSIENS
- .S GMTSIENS(GMTSFILE)="+1,"
- .I $D(GMTSPARENT(GMTSFILE)) D
- ..S GMTSIENS(GMTSFILE)=GMTSIENS(GMTSFILE)_GMTSIENS(GMTSPARENT(GMTSFILE))
- ..S GMTSPFILE=GMTSFILE
- ..F S GMTSPFILE=GMTSPARENT(GMTSPFILE) Q:'$D(GMTSPARENT(GMTSPFILE)) D
- ...S GMTSIENS(GMTSFILE)=GMTSIENS(GMTSFILE)_GMTSIENS(GMTSPARENT(GMTSPFILE))
- .E D
- ..S GMTSTYPE=GMTSTYPE(GMTSFILE)
- ..D BMES^XPDUTL(" Filing """_GMTSDATA(GMTSFILE,.01)_""" "_GMTSTYPE_" in Health Summary")
- .M GMTSFDA(GMTSFILE,GMTSIENS(GMTSFILE))=GMTSDATA(GMTSFILE)
- .I $E(GMTSIENS(GMTSFILE),1)'="+" D FILE^DIE("E","GMTSFDA","GMTSERROR")
- .I $E(GMTSIENS(GMTSFILE),1)="+" D
- ..D UPDATE^DIE("E","GMTSFDA","GMTSIEN","GMTSERROR")
- ..S GMTSIENS(GMTSFILE)=GMTSIEN(1)_","
- ..K GMTSIEN
- .I $D(GMTSERROR) D Q
- ..D MSG^DIALOG("WE",.GMTSMESSAGE,($G(IOM,80)-7),,"GMTSERROR")
- ..D MES^XPDUTL(" Filing error:")
- ..F GMTSLINE=1:1:GMTSMESSAGE D
- ...D MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
- .S GMTSFIELD=0 F S GMTSFIELD=$O(GMTSWPDATA(GMTSFILE,GMTSFIELD)) Q:'+GMTSFIELD!($D(GMTSERROR)) D
- ..M GMTSWP=GMTSWPDATA(GMTSFILE,GMTSFIELD)
- ..D WP^DIE(GMTSFILE,GMTSIENS(GMTSFILE),GMTSFIELD,"","GMTSWP","GMTSERROR")
- ..I $D(GMTSERROR) D
- ...D MSG^DIALOG("WE",.GMTSMESSAGE,($G(IOM,80)-7),,"GMTSERROR")
- ...D MES^XPDUTL(" Filing error:")
- ...F GMTSLINE=1:1:GMTSMESSAGE D
- ....D MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
- I $D(GMTSERROR) Q 0
- D MES^XPDUTL(" Successfully installed new "_GMTSTYPE)
- Q 1
- GETOBJIEN(GMTSNAME) ; Get current or next national IEN in HEALTH SUMMARY OBJECTS file
- N GMTSIEN,GMTSERROR
- S GMTSIEN=+$$FIND1^DIC(142.5,,"X",GMTSNAME,,,"GMTSERROR")
- I GMTSIEN=0 F GMTSIEN=1:1 Q:'$D(^GMT(142.5,GMTSIEN))
- Q GMTSIEN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXPD6 5148 printed Jan 18, 2025@03:02:12 Page 2
- GMTSXPD6 ;ISP/RFR - Health Summary Dist (Type & Objects) ;Jun 22, 2023@18:36
- +1 ;;2.7;Health Summary;**144**;Oct 20, 1995;Build 17
- +2 QUIT
- INSDATA(GMTSTAG,GMTSRTN) ; Install/Update Health Summary File Entry
- +1 ; PARAMETERS: GMTSTAG - TAG CONTAINING TEXT THAT DEFINES FILE ENTRY
- +2 ; GMTSRTN - ROUTINE THAT CONTAINS GMTSTAG
- +3 NEW GMTSPARENT,GMTSLINE,GMTSTXT,GMTSFILE,GMTSFIELD,GMTSVALUE,GMTSERROR
- +4 NEW GMTSDATA,GMTSIEN,GMTSIENS,GMTSSIENS,GMTSFDA,GMTSMESSAGE,GMTSROOT
- +5 NEW GMTSLOC,GMTSTYPE,GMTSWPLINE,GMTSWPDATA,GMTSWP,GMTSADDL,GMTSNAME,GMTSPFILE
- +6 SET GMTSPARENT(142.01)=142
- SET GMTSPARENT(142.2)=142
- SET GMTSPARENT(142.14)=142.01
- +7 SET GMTSADDL(142,99)="S GMTSDATA(GMTSFILE,99)=$H"
- +8 SET GMTSADDL(142.5,"IEN")="S GMTSDATA(GMTSFILE,""IEN"")=$$GETOBJIEN^GMTSXPD6(GMTSDATA(GMTSFILE,.01))"
- +9 SET GMTSADDL(142.5,.18)="S GMTSDATA(GMTSFILE,.18)=$$NOW^XLFDT"
- +10 SET GMTSADDL(142.5,.2)="S GMTSDATA(GMTSFILE,.2)=""YES"""
- +11 FOR GMTSLINE=1:1
- Begin DoDot:1
- +12 SET GMTSLOC=GMTSTAG_"+"_GMTSLINE_U_GMTSRTN
- +13 SET GMTSTXT=$PIECE($TEXT(@(GMTSLOC)),";;",2)
- +14 if GMTSTXT=""
- QUIT
- +15 SET GMTSFILE=$PIECE(GMTSTXT,";",1)
- SET GMTSFIELD=$PIECE(GMTSTXT,";",2)
- +16 SET GMTSVALUE=$PIECE(GMTSTXT,";",3)
- +17 IF GMTSFILE=""!(GMTSFIELD="")
- Begin DoDot:2
- +18 DO MES^XPDUTL(" Invalid data definition at "_GMTSLOC)
- +19 SET GMTSTXT=""
- SET GMTSERROR=1
- End DoDot:2
- QUIT
- +20 IF '$DATA(GMTSTYPE(GMTSFILE,GMTSFIELD))
- Begin DoDot:2
- +21 SET GMTSTYPE(GMTSFILE,GMTSFIELD)=$$GET1^DID(GMTSFILE,GMTSFIELD,,"TYPE",,"GMTSERROR")
- End DoDot:2
- +22 IF $GET(GMTSTYPE(GMTSFILE))=""
- IF '$DATA(GMTSPARENT(GMTSFILE))
- Begin DoDot:2
- +23 SET GMTSNAME=$$LOW^XLFSTR($$GET1^DID(GMTSFILE,,,"NAME",,"GMTSERROR"))
- +24 SET GMTSNAME=$PIECE(GMTSNAME,"health summary ",2)
- +25 IF $EXTRACT(GMTSNAME,*)="s"
- SET GMTSNAME=$EXTRACT(GMTSNAME,1,*-1)
- +26 SET GMTSTYPE(GMTSFILE)=GMTSNAME
- End DoDot:2
- +27 IF GMTSTYPE(GMTSFILE,GMTSFIELD)="WORD-PROCESSING"
- Begin DoDot:2
- +28 SET GMTSWPLINE=1+$ORDER(GMTSWPDATA(GMTSFILE,GMTSFIELD,"?"),-1)
- +29 SET GMTSWPDATA(GMTSFILE,GMTSFIELD,GMTSWPLINE,0)=GMTSVALUE
- End DoDot:2
- +30 IF '$TEST
- SET GMTSDATA(GMTSFILE,GMTSFIELD)=GMTSVALUE
- End DoDot:1
- if GMTSTXT=""
- QUIT
- +31 if $DATA(GMTSERROR)
- QUIT 0
- +32 SET GMTSFILE=0
- +33 FOR
- SET GMTSFILE=$ORDER(GMTSDATA(GMTSFILE))
- if '+GMTSFILE!($DATA(GMTSERROR))
- QUIT
- Begin DoDot:1
- +34 IF $GET(GMTSDATA(GMTSFILE,.01))=""
- Begin DoDot:2
- +35 DO MES^XPDUTL(" Invalid data definition: file #"_GMTSFILE_" has no .01 field")
- +36 SET GMTSERROR=1
- End DoDot:2
- QUIT
- +37 IF $DATA(GMTSPARENT(GMTSFILE))
- IF '$DATA(GMTSIENS(GMTSPARENT(GMTSFILE)))
- Begin DoDot:2
- +38 DO MES^XPDUTL(" Invalid data definition: sub-file #"_GMTSFILE_" has no parent file #"_GMTSPARENT(GMTSFILE)_" definition")
- +39 SET GMTSERROR=1
- End DoDot:2
- QUIT
- +40 SET GMTSFIELD=0
- FOR
- SET GMTSFIELD=$ORDER(GMTSADDL(GMTSFILE,GMTSFIELD))
- if GMTSFIELD=""
- QUIT
- Begin DoDot:2
- +41 XECUTE GMTSADDL(GMTSFILE,GMTSFIELD)
- End DoDot:2
- +42 IF '$DATA(GMTSPARENT(GMTSFILE))
- Begin DoDot:2
- +43 IF +$GET(GMTSDATA(GMTSFILE,"IEN"))=0
- Begin DoDot:3
- +44 SET GMTSSIENS=+$$FIND1^DIC(GMTSFILE,,"X",GMTSDATA(GMTSFILE,.01),,,"GMTSERROR")
- End DoDot:3
- +45 IF +$GET(GMTSDATA(GMTSFILE,"IEN"))>0
- Begin DoDot:3
- +46 SET GMTSIEN(1)=+GMTSDATA(GMTSFILE,"IEN")
- +47 KILL GMTSDATA(GMTSFILE,"IEN")
- +48 SET GMTSROOT=$$GET1^DID(GMTSFILE,,,"GLOBAL NAME",,"GMTSERROR")
- +49 IF $DATA(GMTSERROR)
- Begin DoDot:4
- +50 DO MSG^DIALOG("WE",.GMTSMESSAGE,($GET(IOM,80)-7),,"GMTSERROR")
- +51 DO MES^XPDUTL(" Filing error:")
- +52 FOR GMTSLINE=1:1:GMTSMESSAGE
- Begin DoDot:5
- +53 DO MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
- End DoDot:5
- End DoDot:4
- QUIT
- +54 SET GMTSROOT=GMTSROOT_GMTSIEN(1)_")"
- +55 SET GMTSSIENS=$SELECT($DATA(@GMTSROOT):GMTSIEN(1),1:0)
- End DoDot:3
- if $DATA(GMTSERROR)
- QUIT
- +56 IF GMTSSIENS>0
- Begin DoDot:3
- +57 SET GMTSFDA(GMTSFILE,GMTSSIENS_",",.01)="@"
- +58 DO FILE^DIE("E","GMTSFDA","GMTSERROR")
- +59 IF $DATA(GMTSERROR)
- Begin DoDot:4
- +60 DO MSG^DIALOG("WE",.GMTSMESSAGE,($GET(IOM,80)-7),,"GMTSERROR")
- +61 DO MES^XPDUTL(" Filing error:")
- +62 FOR GMTSLINE=1:1:GMTSMESSAGE
- Begin DoDot:5
- +63 DO MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
- End DoDot:5
- End DoDot:4
- +64 SET GMTSIEN(1)=GMTSSIENS
- End DoDot:3
- End DoDot:2
- if $DATA(GMTSERROR)
- QUIT
- +65 SET GMTSIENS(GMTSFILE)="+1,"
- +66 IF $DATA(GMTSPARENT(GMTSFILE))
- Begin DoDot:2
- +67 SET GMTSIENS(GMTSFILE)=GMTSIENS(GMTSFILE)_GMTSIENS(GMTSPARENT(GMTSFILE))
- +68 SET GMTSPFILE=GMTSFILE
- +69 FOR
- SET GMTSPFILE=GMTSPARENT(GMTSPFILE)
- if '$DATA(GMTSPARENT(GMTSPFILE))
- QUIT
- Begin DoDot:3
- +70 SET GMTSIENS(GMTSFILE)=GMTSIENS(GMTSFILE)_GMTSIENS(GMTSPARENT(GMTSPFILE))
- End DoDot:3
- End DoDot:2
- +71 IF '$TEST
- Begin DoDot:2
- +72 SET GMTSTYPE=GMTSTYPE(GMTSFILE)
- +73 DO BMES^XPDUTL(" Filing """_GMTSDATA(GMTSFILE,.01)_""" "_GMTSTYPE_" in Health Summary")
- End DoDot:2
- +74 MERGE GMTSFDA(GMTSFILE,GMTSIENS(GMTSFILE))=GMTSDATA(GMTSFILE)
- +75 IF $EXTRACT(GMTSIENS(GMTSFILE),1)'="+"
- DO FILE^DIE("E","GMTSFDA","GMTSERROR")
- +76 IF $EXTRACT(GMTSIENS(GMTSFILE),1)="+"
- Begin DoDot:2
- +77 DO UPDATE^DIE("E","GMTSFDA","GMTSIEN","GMTSERROR")
- +78 SET GMTSIENS(GMTSFILE)=GMTSIEN(1)_","
- +79 KILL GMTSIEN
- End DoDot:2
- +80 IF $DATA(GMTSERROR)
- Begin DoDot:2
- +81 DO MSG^DIALOG("WE",.GMTSMESSAGE,($GET(IOM,80)-7),,"GMTSERROR")
- +82 DO MES^XPDUTL(" Filing error:")
- +83 FOR GMTSLINE=1:1:GMTSMESSAGE
- Begin DoDot:3
- +84 DO MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
- End DoDot:3
- End DoDot:2
- QUIT
- +85 SET GMTSFIELD=0
- FOR
- SET GMTSFIELD=$ORDER(GMTSWPDATA(GMTSFILE,GMTSFIELD))
- if '+GMTSFIELD!($DATA(GMTSERROR))
- QUIT
- Begin DoDot:2
- +86 MERGE GMTSWP=GMTSWPDATA(GMTSFILE,GMTSFIELD)
- +87 DO WP^DIE(GMTSFILE,GMTSIENS(GMTSFILE),GMTSFIELD,"","GMTSWP","GMTSERROR")
- +88 IF $DATA(GMTSERROR)
- Begin DoDot:3
- +89 DO MSG^DIALOG("WE",.GMTSMESSAGE,($GET(IOM,80)-7),,"GMTSERROR")
- +90 DO MES^XPDUTL(" Filing error:")
- +91 FOR GMTSLINE=1:1:GMTSMESSAGE
- Begin DoDot:4
- +92 DO MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +93 IF $DATA(GMTSERROR)
- QUIT 0
- +94 DO MES^XPDUTL(" Successfully installed new "_GMTSTYPE)
- +95 QUIT 1
- GETOBJIEN(GMTSNAME) ; Get current or next national IEN in HEALTH SUMMARY OBJECTS file
- +1 NEW GMTSIEN,GMTSERROR
- +2 SET GMTSIEN=+$$FIND1^DIC(142.5,,"X",GMTSNAME,,,"GMTSERROR")
- +3 IF GMTSIEN=0
- FOR GMTSIEN=1:1
- if '$DATA(^GMT(142.5,GMTSIEN))
- QUIT
- +4 QUIT GMTSIEN