- 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 Feb 19, 2025@00:02:21 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