Routine: ALPB8

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 ;

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  Apr 09, 2024@20:45:22                                                                                                                                                                                                        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

ALPB8.m