source: FOIAVistA/tag/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBIN.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1ALPBIN ;OIFO-DALLAS/SED/KC/MW BCMA-BCBU INPT TO HL7 INIT ;5/2/2002
2 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
3 ;
4 ; Reference/IA
5 ; DPT/10035
6 ; DIC(42/10039
7 ; DIC(42/2440
8 Q
9OPT ;Entry point for the option
10 ;Select all or by Division
11ALL ;Ask if the user want to send to all divisions
12 K DTOUT,DUOUT,DIRUT,DIROUT,DIR,ALPALL,ALPWKS,ALPDIV,ALPBDVN
13 S DIR(0)="Y",DIR("B")="YES"
14 S DIR("A")="Enter Yes or No"
15 S DIR("A",1)="Include all Divisions"
16 D ^DIR
17 I $D(DIRUT) G EXIT
18 S ALPALL=+Y
19 ;I +ALPALL>0 D QUE
20 I ALPALL'>0 D DIV
21 ;I +ALPALL'>0!(+ALPWKS>0) D QUE
22 D QUE
23 ;
24EXIT ;
25 K ALPB,ALPBI,ALPBJ,ALPCN,ALDFN,ALPMDT,ALPML,ALPORDR,MSCTR,MSH,ORC
26 K PID,PV1,ALPHLL,ALPALL,DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT,ALPDIV
27 K ALPTST,ALPSTOP,ALPOK,ZTSAVE,ALPCNI,ALPCNT,ALP,ALPDVN
28 Q
29 ;
30DIV K ALPHLL,DIR,ALPDIV,DTOUT,DUOUT,DIRUT,DIROUT
31 S DIR(0)="PO^40.8:EMZ"
32 S DIR("A",1)="Enter the division that you would like to"
33 S DIR("A",2)="initialize"
34 D ^DIR
35 I $D(DIRUT)!(+Y'>0) S ALPDIV="" Q
36 S ALPDIV=$P(Y,U,1),ALPDVN=$P(Y,U,2)
37 D GET^ALPBPARM(.ALPHLL,ALPDIV)
38 I '$D(ALPHLL) W !,"No workstations defined with "_ALPDVN G DIV
39ALLWKS ;If no then set allow the user to select the workstation
40 K DTOUT,DUOUT,DIRUT,DIROUT,DIR
41 S DIR(0)="Y",DIR("B")="YES"
42 S DIR("A")="Enter Yes or No"
43 S DIR("A",1)="Include all workstations for the "_ALPDVN_" Division"
44 D ^DIR
45 I $D(DIRUT) G DIV
46 S ALPWKS=+Y
47 I +ALPWKS>0 Q
48 ;
49WRKSTN ;Now select which workstations for the division to be initialized
50 K ALPSCRN,ALPBANS
51 ;Set up screen
52 S ALP=0 F S ALP=$O(ALPHLL("LINKS",ALP)) Q:+ALP'>0 D
53 . S ALPSCRN($P(ALPHLL("LINKS",ALP),U,2),ALP)=ALPHLL("LINKS",ALP)
54 K ALPHLL
55 F D LP Q:$D(DIRUT)
56 ;I $D(DIRUT)!$D(ALPHLL) W !!,"No Selected Workstations" G ALLWKS
57 I '$D(ALPBANS)!$D(ALPHLL) W !!,"No Selected Workstations" G ALLWKS
58 Q:'$D(ALPBANS)
59 S ALP="",ALPCNT=1
60 F S ALP=$O(ALPBANS(ALP)) Q:ALP="" D
61 . S ALPHLL("LINKS",ALPCNT)=ALPSCRN(ALP,$O(ALPSCRN(ALP,0)))
62 . S ALPCNT=ALPCNT+1
63 K ALPSCRN,ALPBANS
64 Q
65 ;
66LP ;Multiple entries
67 K DIR,DTOUT,DUOUT,DIRUT,DIROUT
68 S DIR(0)="PO^870:EMZ",DIR("A")="Select WorkStation Link "
69 S DIR("?")="Answer with WorkStation Link to update "
70 S DIR("S")="I $D(ALPSCRN($P(^HLCS(870,+Y,0),U,1)))"
71 D ^DIR
72 Q:$D(DIRUT)
73 S ALPBANS($P(Y,U,2),+Y)=""
74 W #,!!,"Selected Workstations",!!
75 S ALPB=""
76 F ALP=1:1 S ALPB=$O(ALPBANS(ALPB)) Q:ALPB="" D
77 .W ?$S(ALP#2:1,1:40),ALPB
78 .W:ALP#2'>0 !
79 Q
80 ;
81QUE ;Que the job
82 ;W !,"QUE"
83 S ZTRTN="EN^ALPBIN"
84 S ZTDESC="PSB - Initialize the Contingency Workstation"
85 S ZTIO="",ZTSAVE("ALPWKS")="",ZTSAVE("ALPDIV")=""
86 I $D(ALPHLL) S ZTSAVE("ALPHLL(")=""
87 D ^%ZTLOAD
88 W:$D(ZTSK) !,ZTSK
89 K ZTIO,ZTDESC,ZTRTN,ZTSK
90 Q
91EN ;Loop through the inpatient list.
92 S ALPDTS=$$FMTE^XLFDT($$NOW^XLFDT)
93 I +$G(ALPDIV)'>0 S ALPDIV=0
94 S ALPSTOP=0,ALPOK=1
95 S ALPCN=""
96 F S ALPCN=$O(^DPT("CN",ALPCN)) Q:ALPCN=""!(ALPSTOP) D
97 . ;DIVISION SCREEN HERE
98 . S ALPCNI=$O(^DIC(42,"B",ALPCN,0))
99 . Q:+ALPCNI'>0 ;Quit if I can't decifer the Ward Location
100 . S ALPTST=$P($G(^DIC(42,ALPCNI,0)),U,11)
101 . I +ALPDIV&(ALPDIV'=ALPTST) Q
102 . S ALPSTOP=$$S^%ZTLOAD()
103 . Q:ALPSTOP
104 . S ALDFN=0
105 . F S ALDFN=$O(^DPT("CN",ALPCN,ALDFN)) Q:+ALDFN'>0!(ALPSTOP) D PAT^ALPBIND
106 ;
107 K XQA,XQAMSG
108 S ALPDTE=$$FMTE^XLFDT($$NOW^XLFDT)
109 S XQA(DUZ)=""
110 S XQAMSG="BCBU WORKSTATION INIT Started "_ALPDTS_" and finished "_ALPDTE_". "
111 ;_ALPBK_" entries sent."
112 D SETUP^XQALERT
113 K ALPDTS,ALPDTE,ALPCNT
114 D EXIT
115 Q
Note: See TracBrowser for help on using the repository browser.