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

GMTSY103.m

Go to the documentation of this file. 
  1. GMTSY103 ;WAT - INSTALL FOR GMTS*2.7*103 ;08/07/13  06:09
  1.  ;;2.7;Health Summary;**103**;Oct 20, 1995;Build 7
  1.  ;
  1.  ;UPDATE^DIE 2053
  1.  ;^DIK 10013
  1.  ;FIND and $$FIND1^DIC 2051
  1.  ;CLEAN^DILF 2054
  1.  ;B/MES^XPDUTL, $$PATCH^XPDUTL 10141
  1.  ;^PXRMEXSI 4371
  1.  ;5687 - allows GMTS to transport Reminder Exchange files in KIDS build
  1.  N GMTSABRT
  1.  I $$PATCH^XPDUTL("GMTS*2.7*103") D BMES^XPDUTL("GMTS*2.7*103 has been previously installed.  Environment check complete.") Q
  1.  D BMES^XPDUTL(" Verifying installation environment...")
  1.  D MES^XPDUTL("Checking Health Summary Component file (#142.1).")
  1.  D MES^XPDUTL("Any environment errors will abort the install and unload the transport global.")
  1.  I $D(^GMT(142.1,257))>0 D
  1.  .D MES^XPDUTL(" Environment Error:  IEN collision with CAT I PT RECORD FLAG STATUS.") S GMTSABRT=1
  1.  .D BMES^XPDUTL("  Health Summary Component file IEN 257 must be empty/non-existent.")
  1.  I +$G(GMTSABRT)<1&(+$$LU(142.1,"CAT I PT RECORD FLAG STATUS","X",,"B")>0) D
  1.  .D MES^XPDUTL(" Environment Error:  NAME collision with CAT I PT RECORD FLAG STATUS.") S GMTSABRT=1
  1.  .D BMES^XPDUTL("  Local Health Summary Component file entry matched to NAME=CAT I PT RECORD FLAG STATUS.")
  1.  I +$G(GMTSABRT)<1&(+$$LU(142.1,"PRF1","X",,"C")>0) D
  1.  .D MES^XPDUTL(" Environment Error:  ABBREVIATION collision with CAT I PT RECORD FLAG STATUS.") S GMTSABRT=1
  1.  .D BMES^XPDUTL("  Local Health Summary Component file entry matched to ABBREVIATION=PRF1.")
  1.  ;
  1.  I +$G(GMTSABRT) D BMES^XPDUTL(" Please re-install GMTS*2.7*103 after the necessary changes have been made.") S XPDABORT=1 Q
  1.  I +$G(GMTSABRT)<1 D BMES^XPDUTL("Environment check passed.  Install will continue...")
  1.  Q
  1.  ;
  1. LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
  1.  Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"MSGERR")
  1.  ;
  1. PRE ;pre
  1.  D DELEX
  1.  Q
  1.  ;
  1. POST ;post
  1.  D BMES^XPDUTL("Installing Health Summary Component...")
  1.  D CI
  1.  D BMES^XPDUTL("Installing Health Summary Types...")
  1.  D STUB
  1.  D SMEXINS^PXRMEXSI("EXARRAY","GMTSY103")
  1.  Q
  1.  ;
  1. CI ; Component Install
  1.  N GMTSIN,GMTSLIM,GMTSINST,GMTSTL,GMTSINST,GMTSTOT,GMTSBLD,GMTSCPS,GMTSCP,GMTSCI
  1.  S GMTSCPS="PRF1"
  1.  F GMTSCI=1:1 Q:'$L($P(GMTSCPS,";",GMTSCI))  D
  1.  . S GMTSCP=$P(GMTSCPS,";",GMTSCI) K GMTSIN
  1.  . D ARRAY Q:'$D(GMTSIN)
  1.  . I $L($G(GMTSIN("TIM"))),+($G(GMTSIN(0)))>0 S GMTSLIM(+($G(GMTSIN(0))),"TIM")=$G(GMTSIN("TIM"))
  1.  . I $L($G(GMTSIN("OCC"))),+($G(GMTSIN(0)))>0 S GMTSLIM(+($G(GMTSIN(0))),"OCC")=$G(GMTSIN("OCC"))
  1.  . S GMTSINST=$$ADD^GMTSXPD1(.GMTSIN),GMTSTOT=+($G(GMTSTOT))+($G(GMTSINST))
  1.  ; Rebuild Ad Hoc Health Summary Type
  1.  D:+($G(GMTSTOT))>0 BUILD^GMTSXPD3
  1.  D LIM
  1.  I +$$ROK("GMTSXPS1")>0 D
  1.  . N GMTSHORT S GMTSHORT=1,GMTSINST="",GMTSBLD="GMTS*2.7*103" D SEND^GMTSXPS1
  1.  Q
  1. ARRAY ; Build Array
  1.  K GMTSIN N GMTSI,GMTSTXT,GMTSEX,GMTSFLD,GMTSUB,GMTSVAL,GMTSPDX S GMTSPDX=1,GMTSCP=$G(GMTSCP) Q:'$L(GMTSCP)
  1.  F GMTSI=1:1 D  Q:'$L(GMTSTXT)
  1.  . S GMTSTXT="",GMTSEX="S GMTSTXT=$T("_GMTSCP_"+"_GMTSI_")" X GMTSEX S:$L(GMTSTXT,";")'>3 GMTSTXT="" Q:'$L(GMTSTXT)
  1.  . S GMTSFLD=$P(GMTSTXT,";",2),GMTSUB=$P(GMTSTXT,";",3),GMTSVAL=$P(GMTSTXT,";",4)
  1.  . S:$E(GMTSFLD,1)=1&(+GMTSFLD<2) GMTSVAL=$P(GMTSTXT,";",4,5)
  1.  . S:$E(GMTSFLD,1)=" "!('$L(GMTSFLD)) GMTSTXT="" Q:GMTSTXT=""
  1.  . S:$L(GMTSFLD)&('$L(GMTSUB)) GMTSIN(GMTSFLD)=GMTSVAL Q:$L(GMTSFLD)&('$L(GMTSUB))  S:$L(GMTSFLD)&($L(GMTSUB)) GMTSIN(GMTSFLD,GMTSUB)=GMTSVAL
  1.  . S:$G(GMTSFLD)=7&(+($G(GMTSUB))>0) GMTSPDX=0
  1.  K:+($G(GMTSPDX))=0 GMTSIN("PDX")
  1.  Q
  1. LIM ; Limits
  1.  N GMTSI,GMTST,GMTSO,GMTSA S GMTSI=0 F  S GMTSI=$O(GMTSLIM(GMTSI)) Q:+GMTSI=0  D
  1.  . S GMTSA=$P($G(^GMT(142.1,+($G(GMTSI)),0)),"^",3),GMTST=$G(GMTSLIM(+GMTSI,"TIM")) S:'$L(GMTST) GMTST=$S(GMTSA="Y ":"1Y ",1:"")
  1.  . S GMTSA=$P($G(^GMT(142.1,+($G(GMTSI)),0)),"^",5),GMTSO=$G(GMTSLIM(+GMTSI,"OCC")) S:'$L(GMTSO) GMTSO=$S(GMTSA="Y ":"10 ",1:"")
  1.  . D TO^GMTSXPD3(GMTSI,GMTST,GMTSO)
  1.  Q
  1. ROK(X) ; Routine OK
  1.  S X=$G(X) Q:'$L(X) 0 N GMTSEX,GMTSTXT S GMTSEX="S GMTSTXT=$T(+1^"_X_")" X GMTSEX
  1.  Q:'$L(GMTSTXT) 0  Q 1
  1.  ;
  1. PRF1 ; CAT I PT RECORD FLAG STATUS Component Data
  1.  ;0;;257
  1.  ;.01;;CAT I PT RECORD FLAG STATUS
  1.  ;1;;EN;GMTSRFHX
  1.  ;1.1;;0
  1.  ;2;;
  1.  ;3;;PRF1
  1.  ;3.5;;4
  1.  ;3.5;1;This component displays the Active and Inactive Category 1 Patient Record
  1.  ;3.5;2;Flags assigned to a given patient.  The full assignment history is
  1.  ;3.5;3;included with each instance of flag assignment.  Active flag assignments
  1.  ;3.5;4;are displayed first, followed by Inactive flag assignments.
  1.  ;4;;
  1.  ;5;;
  1.  ;6;;
  1.  ;7;;0
  1.  ;8;;
  1.  ;9;;
  1.  ;10;;
  1.  ;11;;
  1.  ;12;;
  1.  ;13;;
  1.  ;14;;
  1.  ;PDX;;1
  1.  ;
  1.  Q
  1.  ;
  1. STUB ;create stub entries
  1.  ;UPDATE^DIE(FLAGS,FDA_ROOT,IEN_ROOT,MSG_ROOT)
  1.  D BMES^XPDUTL("Creating stub entries for Remote Health Summary Type.")
  1.  D DELRTYPE
  1.  N FDA,MSG,HSIEN,NAME,NUMBER
  1.  S FDA(142,"+1,",.01)="REMOTE PT RECORD FLAG STATUS"
  1.  S HSIEN(1)=5000021
  1.  D UPDATE^DIE("","FDA","HSIEN","MSG")
  1.  I $D(MSG)>0 D AWRITE("MSG")
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1. DELRTYPE ;remove previous version of type
  1.  D BMES^XPDUTL("Removing any previous version of Remote Health Summary Type")
  1.  N DA,DIK,X,Y
  1.  S DIK="^GMT(142,"
  1.  S DA=5000021 D ^DIK
  1.  S DA=$O(^GMT(142,"B","REMOTE PT RECORD FLAG STATUS","")) D:+$G(DA) ^DIK
  1.  Q
  1.  ;
  1. DELEX ;remove prior version of exchange entry
  1.  N ARRAY,IC,IND,LIST,GMTSVAL,NUM
  1.  D BMES^XPDUTL("Cleaning up any previous versions of Reminder Exchange file entry")
  1.  D EXARRAY("L",.ARRAY)
  1.  S IC=0
  1.  F  S IC=$O(ARRAY(IC)) Q:'IC  D
  1.  . S GMTSVAL(1)=ARRAY(IC,1)
  1.  . D FIND^DIC(811.8,"","","U",.GMTSVAL,"","","","","LIST")
  1.  . I '$D(LIST) Q
  1.  . S NUM=$P(LIST("DILIST",0),U,1)
  1.  . I NUM'=0 D
  1.  .. F IND=1:1:NUM D
  1.  ... N DA,DIK
  1.  ... S DIK="^PXD(811.8,"
  1.  ... S DA=LIST("DILIST",2,IND)
  1.  ... D ^DIK
  1.  Q
  1.  ;
  1. EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
  1.  ;MODE values: I for include in build, A for include action.
  1.  N LN
  1.  S LN=0
  1.  ;
  1.  S LN=LN+1
  1.  S ARRAY(LN,1)="VA-HS TYPES GMTS*2.7*103"
  1.  I MODE["I" S ARRAY(LN,2)="07/18/2013@12:40:38"
  1.  I MODE["A" S ARRAY(LN,3)="O"
  1.  ;
  1.  Q
  1.  ;
  1. AWRITE(REF) ;Write all the descendants of the array reference.
  1.  ;REF is the starting array reference, for example A or ^TMP("PXRM",$J).
  1.  ;coied from PXRMUTIL
  1.  N DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP,GMTSTEXT
  1.  I REF="" Q
  1.  S LN=0
  1.  S PROOT=$P(REF,")",1)
  1.  ;Build the root so we can tell when we are done.
  1.  S TEMP=$NA(@REF)
  1.  S ROOT=$P(TEMP,")",1)
  1.  S REF=$Q(@REF)
  1.  I REF'[ROOT Q
  1.  S DONE=0
  1.  F  Q:(REF="")!(DONE)  D
  1.  . S START=$F(REF,ROOT)
  1.  . S LEN=$L(REF)
  1.  . S IND=$E(REF,START,LEN)
  1.  . S LN=LN+1,GMTSTEXT(LN)=PROOT_IND_"="_@REF
  1.  . S REF=$Q(@REF)
  1.  . I REF'[ROOT S DONE=1
  1.  D MES^XPDUTL(.GMTSTEXT)
  1.  Q
  1.  ;