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