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 Dec 13, 2024@02:01 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
