ALPB8 ;OIFO-DALLAS/SED BCMA-POST INIT ;5/2/2002
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
POST ;Index file 53.7
;Quit if not a workstation
Q:$$KSP^XUPARAM("WHERE")'["BCMABU"
;Index file
N DIK
S DIK="^ALPB(53.7," D IXALL^DIK
;Check for duplicates
N ALPSSN,CNT,ALPMSG,ALPDFN,DIE,DA,DR
S ALPSSN="" F S ALPSSN=$O(^VA(200,"SSN",ALPSSN)) Q:ALPSSN="" D
. I ALPSSN["LOCAL" D
. . S ALPDFN=0 F S ALPDFN=$O(^VA(200,"SSN",ALPSSN,ALPDFN)) Q:ALPDFN<1 D BAD
. S CNT=0
. S ALPDFN="" F S ALPDFN=$O(^VA(200,"SSN",ALPSSN,ALPDFN)) Q:ALPDFN'>0 D
. . S CNT=CNT+1 I CNT>1 D BAD
STOP ;
Q
BAD ;Kill bad SSN or duplicate
S ALPMSG="DFN: "_ALPDFN_" SSN: "_ALPSSN_" NAME: "_$P(^VA(200,ALPDFN,0),U)
D MES^XPDUTL(ALPMSG)
S DIE="^VA(200,",DA=ALPDFN
S DR="7///^S X=1" ;*********disuser
S DR=DR_";2///^S X=""@""" ;*access code
S DR=DR_";9///^S X=""@""" ;*SSN
D ^DIE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPB8 890 printed Sep 23, 2025@19:15:13 Page 2
ALPB8 ;OIFO-DALLAS/SED BCMA-POST INIT ;5/2/2002
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
POST ;Index file 53.7
+1 ;Quit if not a workstation
+2 if $$KSP^XUPARAM("WHERE")'["BCMABU"
QUIT
+3 ;Index file
+4 NEW DIK
+5 SET DIK="^ALPB(53.7,"
DO IXALL^DIK
+6 ;Check for duplicates
+7 NEW ALPSSN,CNT,ALPMSG,ALPDFN,DIE,DA,DR
+8 SET ALPSSN=""
FOR
SET ALPSSN=$ORDER(^VA(200,"SSN",ALPSSN))
if ALPSSN=""
QUIT
Begin DoDot:1
+9 IF ALPSSN["LOCAL"
Begin DoDot:2
+10 SET ALPDFN=0
FOR
SET ALPDFN=$ORDER(^VA(200,"SSN",ALPSSN,ALPDFN))
if ALPDFN<1
QUIT
DO BAD
End DoDot:2
+11 SET CNT=0
+12 SET ALPDFN=""
FOR
SET ALPDFN=$ORDER(^VA(200,"SSN",ALPSSN,ALPDFN))
if ALPDFN'>0
QUIT
Begin DoDot:2
+13 SET CNT=CNT+1
IF CNT>1
DO BAD
End DoDot:2
End DoDot:1
STOP ;
+1 QUIT
BAD ;Kill bad SSN or duplicate
+1 SET ALPMSG="DFN: "_ALPDFN_" SSN: "_ALPSSN_" NAME: "_$PIECE(^VA(200,ALPDFN,0),U)
+2 DO MES^XPDUTL(ALPMSG)
+3 SET DIE="^VA(200,"
SET DA=ALPDFN
+4 ;*********disuser
SET DR="7///^S X=1"
+5 ;*access code
SET DR=DR_";2///^S X=""@"""
+6 ;*SSN
SET DR=DR_";9///^S X=""@"""
+7 DO ^DIE
