Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSXPD6

GMTSXPD6.m

Go to the documentation of this file.
  1. GMTSXPD6 ;ISP/RFR - Health Summary Dist (Type & Objects) ;Jun 22, 2023@18:36
  1. ;;2.7;Health Summary;**144**;Oct 20, 1995;Build 17
  1. Q
  1. INSDATA(GMTSTAG,GMTSRTN) ; Install/Update Health Summary File Entry
  1. ; PARAMETERS: GMTSTAG - TAG CONTAINING TEXT THAT DEFINES FILE ENTRY
  1. ; GMTSRTN - ROUTINE THAT CONTAINS GMTSTAG
  1. N GMTSPARENT,GMTSLINE,GMTSTXT,GMTSFILE,GMTSFIELD,GMTSVALUE,GMTSERROR
  1. N GMTSDATA,GMTSIEN,GMTSIENS,GMTSSIENS,GMTSFDA,GMTSMESSAGE,GMTSROOT
  1. N GMTSLOC,GMTSTYPE,GMTSWPLINE,GMTSWPDATA,GMTSWP,GMTSADDL,GMTSNAME,GMTSPFILE
  1. S GMTSPARENT(142.01)=142,GMTSPARENT(142.2)=142,GMTSPARENT(142.14)=142.01
  1. S GMTSADDL(142,99)="S GMTSDATA(GMTSFILE,99)=$H"
  1. S GMTSADDL(142.5,"IEN")="S GMTSDATA(GMTSFILE,""IEN"")=$$GETOBJIEN^GMTSXPD6(GMTSDATA(GMTSFILE,.01))"
  1. S GMTSADDL(142.5,.18)="S GMTSDATA(GMTSFILE,.18)=$$NOW^XLFDT"
  1. S GMTSADDL(142.5,.2)="S GMTSDATA(GMTSFILE,.2)=""YES"""
  1. F GMTSLINE=1:1 D Q:GMTSTXT=""
  1. .S GMTSLOC=GMTSTAG_"+"_GMTSLINE_U_GMTSRTN
  1. .S GMTSTXT=$P($T(@(GMTSLOC)),";;",2)
  1. .Q:GMTSTXT=""
  1. .S GMTSFILE=$P(GMTSTXT,";",1),GMTSFIELD=$P(GMTSTXT,";",2)
  1. .S GMTSVALUE=$P(GMTSTXT,";",3)
  1. .I GMTSFILE=""!(GMTSFIELD="") D Q
  1. ..D MES^XPDUTL(" Invalid data definition at "_GMTSLOC)
  1. ..S GMTSTXT="",GMTSERROR=1
  1. .I '$D(GMTSTYPE(GMTSFILE,GMTSFIELD)) D
  1. ..S GMTSTYPE(GMTSFILE,GMTSFIELD)=$$GET1^DID(GMTSFILE,GMTSFIELD,,"TYPE",,"GMTSERROR")
  1. .I $G(GMTSTYPE(GMTSFILE))="",'$D(GMTSPARENT(GMTSFILE)) D
  1. ..S GMTSNAME=$$LOW^XLFSTR($$GET1^DID(GMTSFILE,,,"NAME",,"GMTSERROR"))
  1. ..S GMTSNAME=$P(GMTSNAME,"health summary ",2)
  1. ..I $E(GMTSNAME,*)="s" S GMTSNAME=$E(GMTSNAME,1,*-1)
  1. ..S GMTSTYPE(GMTSFILE)=GMTSNAME
  1. .I GMTSTYPE(GMTSFILE,GMTSFIELD)="WORD-PROCESSING" D
  1. ..S GMTSWPLINE=1+$O(GMTSWPDATA(GMTSFILE,GMTSFIELD,"?"),-1)
  1. ..S GMTSWPDATA(GMTSFILE,GMTSFIELD,GMTSWPLINE,0)=GMTSVALUE
  1. .E S GMTSDATA(GMTSFILE,GMTSFIELD)=GMTSVALUE
  1. Q:$D(GMTSERROR) 0
  1. S GMTSFILE=0
  1. F S GMTSFILE=$O(GMTSDATA(GMTSFILE)) Q:'+GMTSFILE!($D(GMTSERROR)) D
  1. .I $G(GMTSDATA(GMTSFILE,.01))="" D Q
  1. ..D MES^XPDUTL(" Invalid data definition: file #"_GMTSFILE_" has no .01 field")
  1. ..S GMTSERROR=1
  1. .I $D(GMTSPARENT(GMTSFILE)),'$D(GMTSIENS(GMTSPARENT(GMTSFILE))) D Q
  1. ..D MES^XPDUTL(" Invalid data definition: sub-file #"_GMTSFILE_" has no parent file #"_GMTSPARENT(GMTSFILE)_" definition")
  1. ..S GMTSERROR=1
  1. .S GMTSFIELD=0 F S GMTSFIELD=$O(GMTSADDL(GMTSFILE,GMTSFIELD)) Q:GMTSFIELD="" D
  1. ..X GMTSADDL(GMTSFILE,GMTSFIELD)
  1. .I '$D(GMTSPARENT(GMTSFILE)) D Q:$D(GMTSERROR)
  1. ..I +$G(GMTSDATA(GMTSFILE,"IEN"))=0 D
  1. ...S GMTSSIENS=+$$FIND1^DIC(GMTSFILE,,"X",GMTSDATA(GMTSFILE,.01),,,"GMTSERROR")
  1. ..I +$G(GMTSDATA(GMTSFILE,"IEN"))>0 D Q:$D(GMTSERROR)
  1. ...S GMTSIEN(1)=+GMTSDATA(GMTSFILE,"IEN")
  1. ...K GMTSDATA(GMTSFILE,"IEN")
  1. ...S GMTSROOT=$$GET1^DID(GMTSFILE,,,"GLOBAL NAME",,"GMTSERROR")
  1. ...I $D(GMTSERROR) D Q
  1. ....D MSG^DIALOG("WE",.GMTSMESSAGE,($G(IOM,80)-7),,"GMTSERROR")
  1. ....D MES^XPDUTL(" Filing error:")
  1. ....F GMTSLINE=1:1:GMTSMESSAGE D
  1. .....D MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
  1. ...S GMTSROOT=GMTSROOT_GMTSIEN(1)_")"
  1. ...S GMTSSIENS=$S($D(@GMTSROOT):GMTSIEN(1),1:0)
  1. ..I GMTSSIENS>0 D
  1. ...S GMTSFDA(GMTSFILE,GMTSSIENS_",",.01)="@"
  1. ...D FILE^DIE("E","GMTSFDA","GMTSERROR")
  1. ...I $D(GMTSERROR) D
  1. ....D MSG^DIALOG("WE",.GMTSMESSAGE,($G(IOM,80)-7),,"GMTSERROR")
  1. ....D MES^XPDUTL(" Filing error:")
  1. ....F GMTSLINE=1:1:GMTSMESSAGE D
  1. .....D MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
  1. ...S GMTSIEN(1)=GMTSSIENS
  1. .S GMTSIENS(GMTSFILE)="+1,"
  1. .I $D(GMTSPARENT(GMTSFILE)) D
  1. ..S GMTSIENS(GMTSFILE)=GMTSIENS(GMTSFILE)_GMTSIENS(GMTSPARENT(GMTSFILE))
  1. ..S GMTSPFILE=GMTSFILE
  1. ..F S GMTSPFILE=GMTSPARENT(GMTSPFILE) Q:'$D(GMTSPARENT(GMTSPFILE)) D
  1. ...S GMTSIENS(GMTSFILE)=GMTSIENS(GMTSFILE)_GMTSIENS(GMTSPARENT(GMTSPFILE))
  1. .E D
  1. ..S GMTSTYPE=GMTSTYPE(GMTSFILE)
  1. ..D BMES^XPDUTL(" Filing """_GMTSDATA(GMTSFILE,.01)_""" "_GMTSTYPE_" in Health Summary")
  1. .M GMTSFDA(GMTSFILE,GMTSIENS(GMTSFILE))=GMTSDATA(GMTSFILE)
  1. .I $E(GMTSIENS(GMTSFILE),1)'="+" D FILE^DIE("E","GMTSFDA","GMTSERROR")
  1. .I $E(GMTSIENS(GMTSFILE),1)="+" D
  1. ..D UPDATE^DIE("E","GMTSFDA","GMTSIEN","GMTSERROR")
  1. ..S GMTSIENS(GMTSFILE)=GMTSIEN(1)_","
  1. ..K GMTSIEN
  1. .I $D(GMTSERROR) D Q
  1. ..D MSG^DIALOG("WE",.GMTSMESSAGE,($G(IOM,80)-7),,"GMTSERROR")
  1. ..D MES^XPDUTL(" Filing error:")
  1. ..F GMTSLINE=1:1:GMTSMESSAGE D
  1. ...D MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
  1. .S GMTSFIELD=0 F S GMTSFIELD=$O(GMTSWPDATA(GMTSFILE,GMTSFIELD)) Q:'+GMTSFIELD!($D(GMTSERROR)) D
  1. ..M GMTSWP=GMTSWPDATA(GMTSFILE,GMTSFIELD)
  1. ..D WP^DIE(GMTSFILE,GMTSIENS(GMTSFILE),GMTSFIELD,"","GMTSWP","GMTSERROR")
  1. ..I $D(GMTSERROR) D
  1. ...D MSG^DIALOG("WE",.GMTSMESSAGE,($G(IOM,80)-7),,"GMTSERROR")
  1. ...D MES^XPDUTL(" Filing error:")
  1. ...F GMTSLINE=1:1:GMTSMESSAGE D
  1. ....D MES^XPDUTL(" "_GMTSMESSAGE(GMTSLINE))
  1. I $D(GMTSERROR) Q 0
  1. D MES^XPDUTL(" Successfully installed new "_GMTSTYPE)
  1. Q 1
  1. GETOBJIEN(GMTSNAME) ; Get current or next national IEN in HEALTH SUMMARY OBJECTS file
  1. N GMTSIEN,GMTSERROR
  1. S GMTSIEN=+$$FIND1^DIC(142.5,,"X",GMTSNAME,,,"GMTSERROR")
  1. I GMTSIEN=0 F GMTSIEN=1:1 Q:'$D(^GMT(142.5,GMTSIEN))
  1. Q GMTSIEN