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 ---[H[J[2J[HACKQIPS1 762 printed Nov 22, 2024@17:42:18 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
