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