VistA-WorldVistAEHR/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBIN.m

116 lines
3.3 KiB
Mathematica

ALPBIN ;OIFO-DALLAS/SED/KC/MW BCMA-BCBU INPT TO HL7 INIT ;5/2/2002
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
; Reference/IA
; DPT/10035
; DIC(42/10039
; DIC(42/2440
Q
OPT ;Entry point for the option
;Select all or by Division
ALL ;Ask if the user want to send to all divisions
K DTOUT,DUOUT,DIRUT,DIROUT,DIR,ALPALL,ALPWKS,ALPDIV,ALPBDVN
S DIR(0)="Y",DIR("B")="YES"
S DIR("A")="Enter Yes or No"
S DIR("A",1)="Include all Divisions"
D ^DIR
I $D(DIRUT) G EXIT
S ALPALL=+Y
;I +ALPALL>0 D QUE
I ALPALL'>0 D DIV
;I +ALPALL'>0!(+ALPWKS>0) D QUE
D QUE
;
EXIT ;
K ALPB,ALPBI,ALPBJ,ALPCN,ALDFN,ALPMDT,ALPML,ALPORDR,MSCTR,MSH,ORC
K PID,PV1,ALPHLL,ALPALL,DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT,ALPDIV
K ALPTST,ALPSTOP,ALPOK,ZTSAVE,ALPCNI,ALPCNT,ALP,ALPDVN
Q
;
DIV K ALPHLL,DIR,ALPDIV,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="PO^40.8:EMZ"
S DIR("A",1)="Enter the division that you would like to"
S DIR("A",2)="initialize"
D ^DIR
I $D(DIRUT)!(+Y'>0) S ALPDIV="" Q
S ALPDIV=$P(Y,U,1),ALPDVN=$P(Y,U,2)
D GET^ALPBPARM(.ALPHLL,ALPDIV)
I '$D(ALPHLL) W !,"No workstations defined with "_ALPDVN G DIV
ALLWKS ;If no then set allow the user to select the workstation
K DTOUT,DUOUT,DIRUT,DIROUT,DIR
S DIR(0)="Y",DIR("B")="YES"
S DIR("A")="Enter Yes or No"
S DIR("A",1)="Include all workstations for the "_ALPDVN_" Division"
D ^DIR
I $D(DIRUT) G DIV
S ALPWKS=+Y
I +ALPWKS>0 Q
;
WRKSTN ;Now select which workstations for the division to be initialized
K ALPSCRN,ALPBANS
;Set up screen
S ALP=0 F S ALP=$O(ALPHLL("LINKS",ALP)) Q:+ALP'>0 D
. S ALPSCRN($P(ALPHLL("LINKS",ALP),U,2),ALP)=ALPHLL("LINKS",ALP)
K ALPHLL
F D LP Q:$D(DIRUT)
;I $D(DIRUT)!$D(ALPHLL) W !!,"No Selected Workstations" G ALLWKS
I '$D(ALPBANS)!$D(ALPHLL) W !!,"No Selected Workstations" G ALLWKS
Q:'$D(ALPBANS)
S ALP="",ALPCNT=1
F S ALP=$O(ALPBANS(ALP)) Q:ALP="" D
. S ALPHLL("LINKS",ALPCNT)=ALPSCRN(ALP,$O(ALPSCRN(ALP,0)))
. S ALPCNT=ALPCNT+1
K ALPSCRN,ALPBANS
Q
;
LP ;Multiple entries
K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="PO^870:EMZ",DIR("A")="Select WorkStation Link "
S DIR("?")="Answer with WorkStation Link to update "
S DIR("S")="I $D(ALPSCRN($P(^HLCS(870,+Y,0),U,1)))"
D ^DIR
Q:$D(DIRUT)
S ALPBANS($P(Y,U,2),+Y)=""
W #,!!,"Selected Workstations",!!
S ALPB=""
F ALP=1:1 S ALPB=$O(ALPBANS(ALPB)) Q:ALPB="" D
.W ?$S(ALP#2:1,1:40),ALPB
.W:ALP#2'>0 !
Q
;
QUE ;Que the job
;W !,"QUE"
S ZTRTN="EN^ALPBIN"
S ZTDESC="PSB - Initialize the Contingency Workstation"
S ZTIO="",ZTSAVE("ALPWKS")="",ZTSAVE("ALPDIV")=""
I $D(ALPHLL) S ZTSAVE("ALPHLL(")=""
D ^%ZTLOAD
W:$D(ZTSK) !,ZTSK
K ZTIO,ZTDESC,ZTRTN,ZTSK
Q
EN ;Loop through the inpatient list.
S ALPDTS=$$FMTE^XLFDT($$NOW^XLFDT)
I +$G(ALPDIV)'>0 S ALPDIV=0
S ALPSTOP=0,ALPOK=1
S ALPCN=""
F S ALPCN=$O(^DPT("CN",ALPCN)) Q:ALPCN=""!(ALPSTOP) D
. ;DIVISION SCREEN HERE
. S ALPCNI=$O(^DIC(42,"B",ALPCN,0))
. Q:+ALPCNI'>0 ;Quit if I can't decifer the Ward Location
. S ALPTST=$P($G(^DIC(42,ALPCNI,0)),U,11)
. I +ALPDIV&(ALPDIV'=ALPTST) Q
. S ALPSTOP=$$S^%ZTLOAD()
. Q:ALPSTOP
. S ALDFN=0
. F S ALDFN=$O(^DPT("CN",ALPCN,ALDFN)) Q:+ALDFN'>0!(ALPSTOP) D PAT^ALPBIND
;
K XQA,XQAMSG
S ALPDTE=$$FMTE^XLFDT($$NOW^XLFDT)
S XQA(DUZ)=""
S XQAMSG="BCBU WORKSTATION INIT Started "_ALPDTS_" and finished "_ALPDTE_". "
;_ALPBK_" entries sent."
D SETUP^XQALERT
K ALPDTS,ALPDTE,ALPCNT
D EXIT
Q