source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPB8.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 863 bytes
Line 
1ALPB8 ;OIFO-DALLAS/SED BCMA-POST INIT ;5/2/2002
2 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
3 ;
4POST ;Index file 53.7
5 ;Quit if not a workstation
6 Q:$$KSP^XUPARAM("WHERE")'["BCMABU"
7 ;Index file
8 N DIK
9 S DIK="^ALPB(53.7," D IXALL^DIK
10 ;Check for duplicates
11 N ALPSSN,CNT,ALPMSG,ALPDFN,DIE,DA,DR
12 S ALPSSN="" F S ALPSSN=$O(^VA(200,"SSN",ALPSSN)) Q:ALPSSN="" D
13 . I ALPSSN["LOCAL" D
14 . . S ALPDFN=0 F S ALPDFN=$O(^VA(200,"SSN",ALPSSN,ALPDFN)) Q:ALPDFN<1 D BAD
15 . S CNT=0
16 . S ALPDFN="" F S ALPDFN=$O(^VA(200,"SSN",ALPSSN,ALPDFN)) Q:ALPDFN'>0 D
17 . . S CNT=CNT+1 I CNT>1 D BAD
18STOP ;
19 Q
20BAD ;Kill bad SSN or duplicate
21 S ALPMSG="DFN: "_ALPDFN_" SSN: "_ALPSSN_" NAME: "_$P(^VA(200,ALPDFN,0),U)
22 D MES^XPDUTL(ALPMSG)
23 S DIE="^VA(200,",DA=ALPDFN
24 S DR="7///^S X=1" ;*********disuser
25 S DR=DR_";2///^S X=""@""" ;*access code
26 S DR=DR_";9///^S X=""@""" ;*SSN
27 D ^DIE
Note: See TracBrowser for help on using the repository browser.