DG53149P ;SF/CMC,PTD,DLR-PRE and POST INSTALL FOR DG*5.3*149 ;1/14/99
;;5.3;Registration;**149**;Aug 13, 1993
;
PRE ;Pre-Install for DG*5.3*149
L +^XTMP("NO NEW JOBS"):60 I '$T D BMES^XPDUTL("Unable to get lock on VAFC BATCH UPDATE task, Install Aborted!") S XPDABORT=2 Q
L +^XTMP("ADT/HL7 VAFC BATCH UPDATE"):60 I '$T D BMES^XPDUTL("Unable to get lock on VAFC BATCH UPDATE task, Install Aborted!") S XPDABORT=2 Q
L +^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7"):1 I '$T D BMES^XPDUTL("Unable to get lock on VAFC BATCH UPDATE task, Install Aborted!") S XPDABORT=2 Q
Q
;
POST ;Post-Install for DG*5.3*149
L -^XTMP("NO NEW JOBS")
L -^XTMP("ADT/HL7 VAFC BATCH UPDATE")
L -^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7")
;
HL7SITE ;Update FACILITY in the HL7 APPLICATION PARAMETER file.
N DA,DIC,DIE,DR,I,SITE,X,Y
S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3),SITE=SITE\1
; ^ SITE is Station Number of site doing install
S DIC="^HL(771,",DIC(0)="XQZ",X="VAFC PIMS"
D ^DIC Q:+Y<0
S DA=+Y,DIE="^HL(771,",DR="3///^S X=SITE"
D ^DIE
K DA,DIC,DIE,DR,I,SITE,X,Y
;
COMPILE N GLOBAL,FIELD,CFIELD,NFIELD,TEMPLATP,TEMPLATN
;
D BMES^XPDUTL("Beginning to compile templates on the patient file.")
;
S NFIELD=$P($T(AFIELDS),";;",2) ;get the fields that have new xref
;
F GLOBAL="^DIE","^DIPT" DO
.I GLOBAL="^DIE" D BMES^XPDUTL(" Compiling Input Templates")
.I GLOBAL="^DIPT" DO
. . D BMES^XPDUTL(" ")
. . D BMES^XPDUTL(" Compiling Print Templates")
.;
.S FIELD=0
.; go find templates on fields that have added cross-ref
.F S FIELD=$O(@GLOBAL@("AF",2,FIELD)) Q:'FIELD DO
. .;
. .S CFIELD=","_FIELD_","
. .;if we didn't add the cross reference, quit
. .I NFIELD'[CFIELD Q
. .;
. .S TEMPLATP=0
. .F S TEMPLATP=$O(@GLOBAL@("AF",2,FIELD,TEMPLATP)) Q:'TEMPLATP DO
. . . S TEMPLATN=$P($G(@GLOBAL@(TEMPLATP,0)),"^",1)
. . . I TEMPLATN="" DO Q
. . . . D BMES^XPDUTL("Could not compile template "_TEMPLATN_$C(13,10)_"Please review!")
. . . .;
. . . S X=$P($G(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
. . . I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))'=0) DO Q
. . . . D BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$C(13,10)_"Please review!")
. . . I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))=0) Q
. . . I $D(FIELD(X)) Q ;already compiled
. . .;
. . . S FIELD(X)="" ; remember the template was compiled
. . . S Y=TEMPLATP ; set up the call for fman
. . . S DMAX=$$ROUSIZE^DILF
. . . I GLOBAL="^DIE" D EN^DIEZ Q
. . . I GLOBAL="^DIPT" D EN^DIPZ Q
.;
W !!!
S (X,Y)=""
D BMES^XPDUTL("The following routine namespace was compiled:")
F S X=$O(FIELD(X)) Q:X="" DO
. S Y=$G(Y)+1 S PRINT(Y)=" "_X_"*"
;
D MES^XPDUTL(.PRINT)
Q
;
;these are the fields that have a new cross-ref
AFIELDS ;;,.01,.02,.03,.05,.08,.09,.111,.1112,.112,.113,.114,.115,.117,.131,.132,.211,.219,.2403,.301,.302,.31115,.323,.351,391,991.01,991.02,991.03,991.04,991.05,991.06,9910.7,1901,
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53149P 2986 printed Dec 13, 2024@02:36:18 Page 2
DG53149P ;SF/CMC,PTD,DLR-PRE and POST INSTALL FOR DG*5.3*149 ;1/14/99
+1 ;;5.3;Registration;**149**;Aug 13, 1993
+2 ;
PRE ;Pre-Install for DG*5.3*149
+1 LOCK +^XTMP("NO NEW JOBS"):60
IF '$TEST
DO BMES^XPDUTL("Unable to get lock on VAFC BATCH UPDATE task, Install Aborted!")
SET XPDABORT=2
QUIT
+2 LOCK +^XTMP("ADT/HL7 VAFC BATCH UPDATE"):60
IF '$TEST
DO BMES^XPDUTL("Unable to get lock on VAFC BATCH UPDATE task, Install Aborted!")
SET XPDABORT=2
QUIT
+3 LOCK +^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7"):1
IF '$TEST
DO BMES^XPDUTL("Unable to get lock on VAFC BATCH UPDATE task, Install Aborted!")
SET XPDABORT=2
QUIT
+4 QUIT
+5 ;
POST ;Post-Install for DG*5.3*149
+1 LOCK -^XTMP("NO NEW JOBS")
+2 LOCK -^XTMP("ADT/HL7 VAFC BATCH UPDATE")
+3 LOCK -^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7")
+4 ;
HL7SITE ;Update FACILITY in the HL7 APPLICATION PARAMETER file.
+1 NEW DA,DIC,DIE,DR,I,SITE,X,Y
+2 SET SITE=$$SITE^VASITE
SET SITE=$PIECE(SITE,"^",3)
SET SITE=SITE\1
+3 ; ^ SITE is Station Number of site doing install
+4 SET DIC="^HL(771,"
SET DIC(0)="XQZ"
SET X="VAFC PIMS"
+5 DO ^DIC
if +Y<0
QUIT
+6 SET DA=+Y
SET DIE="^HL(771,"
SET DR="3///^S X=SITE"
+7 DO ^DIE
+8 KILL DA,DIC,DIE,DR,I,SITE,X,Y
+9 ;
COMPILE NEW GLOBAL,FIELD,CFIELD,NFIELD,TEMPLATP,TEMPLATN
+1 ;
+2 DO BMES^XPDUTL("Beginning to compile templates on the patient file.")
+3 ;
+4 ;get the fields that have new xref
SET NFIELD=$PIECE($TEXT(AFIELDS),";;",2)
+5 ;
+6 FOR GLOBAL="^DIE","^DIPT"
Begin DoDot:1
+7 IF GLOBAL="^DIE"
DO BMES^XPDUTL(" Compiling Input Templates")
+8 IF GLOBAL="^DIPT"
Begin DoDot:2
+9 DO BMES^XPDUTL(" ")
+10 DO BMES^XPDUTL(" Compiling Print Templates")
End DoDot:2
+11 ;
+12 SET FIELD=0
+13 ; go find templates on fields that have added cross-ref
+14 FOR
SET FIELD=$ORDER(@GLOBAL@("AF",2,FIELD))
if 'FIELD
QUIT
Begin DoDot:2
+15 ;
+16 SET CFIELD=","_FIELD_","
+17 ;if we didn't add the cross reference, quit
+18 IF NFIELD'[CFIELD
QUIT
+19 ;
+20 SET TEMPLATP=0
+21 FOR
SET TEMPLATP=$ORDER(@GLOBAL@("AF",2,FIELD,TEMPLATP))
if 'TEMPLATP
QUIT
Begin DoDot:3
+22 SET TEMPLATN=$PIECE($GET(@GLOBAL@(TEMPLATP,0)),"^",1)
+23 IF TEMPLATN=""
Begin DoDot:4
+24 DO BMES^XPDUTL("Could not compile template "_TEMPLATN_$CHAR(13,10)_"Please review!")
+25 ;
End DoDot:4
QUIT
+26 SET X=$PIECE($GET(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
+27 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))'=0)
Begin DoDot:4
+28 DO BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$CHAR(13,10)_"Please review!")
End DoDot:4
QUIT
+29 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))=0)
QUIT
+30 ;already compiled
IF $DATA(FIELD(X))
QUIT
+31 ;
+32 ; remember the template was compiled
SET FIELD(X)=""
+33 ; set up the call for fman
SET Y=TEMPLATP
+34 SET DMAX=$$ROUSIZE^DILF
+35 IF GLOBAL="^DIE"
DO EN^DIEZ
QUIT
+36 IF GLOBAL="^DIPT"
DO EN^DIPZ
QUIT
End DoDot:3
End DoDot:2
+37 ;
End DoDot:1
+38 WRITE !!!
+39 SET (X,Y)=""
+40 DO BMES^XPDUTL("The following routine namespace was compiled:")
+41 FOR
SET X=$ORDER(FIELD(X))
if X=""
QUIT
Begin DoDot:1
+42 SET Y=$GET(Y)+1
SET PRINT(Y)=" "_X_"*"
End DoDot:1
+43 ;
+44 DO MES^XPDUTL(.PRINT)
+45 QUIT
+46 ;
+47 ;these are the fields that have a new cross-ref
AFIELDS ;;,.01,.02,.03,.05,.08,.09,.111,.1112,.112,.113,.114,.115,.117,.131,.132,.211,.219,.2403,.301,.302,.31115,.323,.351,391,991.01,991.02,991.03,991.04,991.05,991.06,9910.7,1901,
+1 QUIT
