VAFHPRE.m

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 ---VAFHPRE   1728     printed  Apr 09, 2024@22:03:05                                                                                                                                                                                                     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