VAFHPRE ;ALB/JRP,PKE - PRE INIT DRIVER;28-MAY-1996
;;5.3;Registration;**91**;AUG 13, 1993
;
CHKPTS ;Create check points for pre-init
;Input : All variables set by KIDS
;Output : None
;
;Declare variables
N TMP
;Create check points
;just set the ADT send HL7 messages switch off
S TMP=$$NEWCP^XPDUTL("VAFH01","NOSEND^VAFHPRE")
;
; clean up old 391 cross-reference from previous versions
S TMP=$$NEWCP^XPDUTL("VAFH02","XREF391^VAFHPRE")
;
; remove old DD(43,391.7011) so it can be replaced by 391.7012
S TMP=$$NEWCP^XPDUTL("VAFH03","DD7011^VAFHPRE")
QUIT
;
;
;
NOSEND ; Set the MAS Parameter Switch, SEND PIMS HL7 MESSAGE to STOP
;
;Input : None
;Output : None
;Note : This is a KIDS complient check point
;
I '$$NOSEND^VAFHUTL Q
D BMES^XPDUTL("Failed to set the MAS Parameter Switch 'SEND PIMS HL7 MESSAGES' to STOP")
Q
;
XREF391 ; remove old 391 cross-reference from previous versions
; 991 will be used instead except for dd(2,.363,1,391)
;
;Input : None
;Outout : None
;
N VAFCX,NOOP
F VAFCX=.01,.02,.03,.06,.09,.351 DO
.I '$D(^DD(2,VAFCX,1,391,0)) Q
.I VAFCX=.01 DO
. . D BMES^XPDUTL("Removing old DD(2,,1,391) cross reference from Test Sites")
.S NOOP=1
.S DIK="^DD(2,VAFCX,1,"
.S DA=391
.S DA(1)=1
.S DA(2)=VAFCX
.S DA(3)=2
.D ^DIK
.K DIK,DA
.;W "."
I $G(NOOP) D BMES^XPDUTL("......")
Q
;
DD7011 ; delete 43,391.7011 for replacement by 43,391.7012
N VAFCX,NOOP
I $D(^DD(43,391.7011)) DO
.D BMES^XPDUTL("Removing field 391.7011 from file 43 at test sites")
.S NOOP=1
.S DIK="^DD(43,"
.S DA=391.7011
.S DA(1)=43
.D ^DIK K DIK,DA
.;W "."
I $G(NOOP) D BMES^XPDUTL(".Field 391.7011 removed")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHPRE 1728 printed Oct 16, 2024@19:04:17 Page 2
VAFHPRE ;ALB/JRP,PKE - PRE INIT DRIVER;28-MAY-1996
+1 ;;5.3;Registration;**91**;AUG 13, 1993
+2 ;
CHKPTS ;Create check points for pre-init
+1 ;Input : All variables set by KIDS
+2 ;Output : None
+3 ;
+4 ;Declare variables
+5 NEW TMP
+6 ;Create check points
+7 ;just set the ADT send HL7 messages switch off
+8 SET TMP=$$NEWCP^XPDUTL("VAFH01","NOSEND^VAFHPRE")
+9 ;
+10 ; clean up old 391 cross-reference from previous versions
+11 SET TMP=$$NEWCP^XPDUTL("VAFH02","XREF391^VAFHPRE")
+12 ;
+13 ; remove old DD(43,391.7011) so it can be replaced by 391.7012
+14 SET TMP=$$NEWCP^XPDUTL("VAFH03","DD7011^VAFHPRE")
+15 QUIT
+16 ;
+17 ;
+18 ;
NOSEND ; Set the MAS Parameter Switch, SEND PIMS HL7 MESSAGE to STOP
+1 ;
+2 ;Input : None
+3 ;Output : None
+4 ;Note : This is a KIDS complient check point
+5 ;
+6 IF '$$NOSEND^VAFHUTL
QUIT
+7 DO BMES^XPDUTL("Failed to set the MAS Parameter Switch 'SEND PIMS HL7 MESSAGES' to STOP")
+8 QUIT
+9 ;
XREF391 ; remove old 391 cross-reference from previous versions
+1 ; 991 will be used instead except for dd(2,.363,1,391)
+2 ;
+3 ;Input : None
+4 ;Outout : None
+5 ;
+6 NEW VAFCX,NOOP
+7 FOR VAFCX=.01,.02,.03,.06,.09,.351
Begin DoDot:1
+8 IF '$DATA(^DD(2,VAFCX,1,391,0))
QUIT
+9 IF VAFCX=.01
Begin DoDot:2
+10 DO BMES^XPDUTL("Removing old DD(2,,1,391) cross reference from Test Sites")
End DoDot:2
+11 SET NOOP=1
+12 SET DIK="^DD(2,VAFCX,1,"
+13 SET DA=391
+14 SET DA(1)=1
+15 SET DA(2)=VAFCX
+16 SET DA(3)=2
+17 DO ^DIK
+18 KILL DIK,DA
+19 ;W "."
End DoDot:1
+20 IF $GET(NOOP)
DO BMES^XPDUTL("......")
+21 QUIT
+22 ;
DD7011 ; delete 43,391.7011 for replacement by 43,391.7012
+1 NEW VAFCX,NOOP
+2 IF $DATA(^DD(43,391.7011))
Begin DoDot:1
+3 DO BMES^XPDUTL("Removing field 391.7011 from file 43 at test sites")
+4 SET NOOP=1
+5 SET DIK="^DD(43,"
+6 SET DA=391.7011
+7 SET DA(1)=43
+8 DO ^DIK
KILL DIK,DA
+9 ;W "."
End DoDot:1
+10 IF $GET(NOOP)
DO BMES^XPDUTL(".Field 391.7011 removed")
+11 QUIT
