ACKQIPS1.m

ACKQIPS1 ;HCIOFO/BH-Version 3 Post Installation routine ;  04/01/99

 ;;3.0;QUASAR;;Feb 11, 2000

 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

 ;

STAFF I ^TMP("ACKQIPST","SKIP") G EXIT   ;  Virgin Site

 D BMES^XPDUTL("Updating A&SP Staff file to no longer point to New Person file.")

 ;

 N ACK1,ACK2,ACK

 S ACK1=0,ACKCNT=0

 F  S ACK1=$O(^ACK(509850.3,ACK1)) Q:'+ACK1  D

 . S ACK2=""

 . S ACK2=$O(^USR(8930.3,"B",ACK1,ACK2))

 . K ACK S ACK(509850.3,ACK1_",",.01)=ACK2 D FILE^DIE("","ACK")

 ;

 ;  Creates new 'D' Cross Reference on Staff File.

 K ^ACK(509850.3,"D")

 S DIK="^ACK(509850.3,"

 S DIK(1)=".01^D"

 D ENALL^DIK

 D BMES^XPDUTL("Completed updating A&SP Staff file.")

 ;

EXIT ;

 K ^TMP("ACKQIPST","SKIP")

 ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ACKQIPS1   762     printed  Apr 09, 2024@21:35:40                                                                                                                                                                                                     Page 2

ACKQIPS1  ;HCIOFO/BH-Version 3 Post Installation routine ;  04/01/99

 +1       ;;3.0;QUASAR;;Feb 11, 2000

 +2       ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

 +3       ;

STAFF     ;  Virgin Site

           IF ^TMP("ACKQIPST","SKIP")

               GOTO EXIT

 +1        DO BMES^XPDUTL("Updating A&SP Staff file to no longer point to New Person file.")

 +2       ;

 +3        NEW ACK1,ACK2,ACK

 +4        SET ACK1=0

           SET ACKCNT=0

 +5        FOR 

               SET ACK1=$ORDER(^ACK(509850.3,ACK1))

               if '+ACK1

                   QUIT 

               Begin DoDot:1

 +6                SET ACK2=""

 +7                SET ACK2=$ORDER(^USR(8930.3,"B",ACK1,ACK2))

 +8                KILL ACK

                   SET ACK(509850.3,ACK1_",",.01)=ACK2

                   DO FILE^DIE("","ACK")

               End DoDot:1

 +9       ;

 +10      ;  Creates new 'D' Cross Reference on Staff File.

 +11       KILL ^ACK(509850.3,"D")

 +12       SET DIK="^ACK(509850.3,"

 +13       SET DIK(1)=".01^D"

 +14       DO ENALL^DIK

 +15       DO BMES^XPDUTL("Completed updating A&SP Staff file.")

 +16      ;

EXIT      ;

 +1        KILL ^TMP("ACKQIPST","SKIP")

 +2       ;

 +3        QUIT