GMRYXENV ;HIRMFO/FT-Environment Check for intake & Output v4.0 ;1/21/97 14:26
;;4.0;Intake/Output;;Apr 25, 1997
GMRY ;
I +$$VERSION^XPDUTL("REGISTRATION")<5.3 D BMES^XPDUTL("PIMS (MAS) V5.3 OR GREATER IS REQUIRED - CANNOT CONTINUE") S XPDABORT=2 Q
Q:+$$VERSION^XPDUTL("GMRY")'>0 ;quit if virgin install
; find how many entries exist in Package File (#9.4)
K GMRYIEN,GMRYERR
D FIND^DIC(9.4,"","","X","GMRY","","C","","","GMRYIEN","GMRYERR")
; quit if FileMan lookup errors out
I +$G(GMRYERR("DIERR")) D S GMRYSTOP=1 D KILL Q
.K GMRYMSG
.S GMRYMSG(1)="Error trying to lookup Intake & Output in the PACKAGE (#9.4) file."
.S GMRYMSG(2)="Halting."
.D BMES^XPDUTL(.GMRYMSG)
.Q
; delete duplicates
; keep GEN. MED. REC. - I/O entry
S GMRYSEQ=0
F S GMRYSEQ=$O(GMRYIEN("DILIST",1,GMRYSEQ)) Q:GMRYSEQ'>0 D
. S GMRYNAME=$G(GMRYIEN("DILIST",1,GMRYSEQ)) Q:GMRYNAME=""
. I GMRYNAME="GEN. MED. REC. - I/O" Q
. S DA=$G(GMRYIEN("DILIST",2,GMRYSEQ))
. I DA S DIK="^DIC(9.4," D ^DIK
. Q
KILL ;
S:$G(GMRYSTOP) XPDABORT=2 ;don't install transport global/leave in ^XTMP
K DA,DIK,GMRYERR,GMRYIEN,GMRYMSG,GMRYNAME,GMRYSEQ,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYXENV 1163 printed Dec 13, 2024@01:55:55 Page 2
GMRYXENV ;HIRMFO/FT-Environment Check for intake & Output v4.0 ;1/21/97 14:26
+1 ;;4.0;Intake/Output;;Apr 25, 1997
GMRY ;
+1 IF +$$VERSION^XPDUTL("REGISTRATION")<5.3
DO BMES^XPDUTL("PIMS (MAS) V5.3 OR GREATER IS REQUIRED - CANNOT CONTINUE")
SET XPDABORT=2
QUIT
+2 ;quit if virgin install
if +$$VERSION^XPDUTL("GMRY")'>0
QUIT
+3 ; find how many entries exist in Package File (#9.4)
+4 KILL GMRYIEN,GMRYERR
+5 DO FIND^DIC(9.4,"","","X","GMRY","","C","","","GMRYIEN","GMRYERR")
+6 ; quit if FileMan lookup errors out
+7 IF +$GET(GMRYERR("DIERR"))
Begin DoDot:1
+8 KILL GMRYMSG
+9 SET GMRYMSG(1)="Error trying to lookup Intake & Output in the PACKAGE (#9.4) file."
+10 SET GMRYMSG(2)="Halting."
+11 DO BMES^XPDUTL(.GMRYMSG)
+12 QUIT
End DoDot:1
SET GMRYSTOP=1
DO KILL
QUIT
+13 ; delete duplicates
+14 ; keep GEN. MED. REC. - I/O entry
+15 SET GMRYSEQ=0
+16 FOR
SET GMRYSEQ=$ORDER(GMRYIEN("DILIST",1,GMRYSEQ))
if GMRYSEQ'>0
QUIT
Begin DoDot:1
+17 SET GMRYNAME=$GET(GMRYIEN("DILIST",1,GMRYSEQ))
if GMRYNAME=""
QUIT
+18 IF GMRYNAME="GEN. MED. REC. - I/O"
QUIT
+19 SET DA=$GET(GMRYIEN("DILIST",2,GMRYSEQ))
+20 IF DA
SET DIK="^DIC(9.4,"
DO ^DIK
+21 QUIT
End DoDot:1
KILL ;
+1 ;don't install transport global/leave in ^XTMP
if $GET(GMRYSTOP)
SET XPDABORT=2
+2 KILL DA,DIK,GMRYERR,GMRYIEN,GMRYMSG,GMRYNAME,GMRYSEQ,X,Y
+3 QUIT
