ALPBIND ;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
; EN^PSJBCBU/3876
Q
OPT ;Entry point for the option
;Select Workstations assigned to Default.
DFT K ALPHLL,DIR,ALPDIV,DTOUT,DUOUT,DIRUT,DIROUT
D GET^ALPBPARM(.ALPHLL,"")
I '$D(ALPHLL) W !,"No workstations defined for default " G EXIT
D ALLWKS
;D:'$D(DIRUT) QUE
D QUE
G EXIT
;
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"
D ^DIR
I $D(DIRUT) Q
S ALPWKS=+Y
I +ALPWKS>0 Q
;
WRKSTN ;Now select which workstations 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^ALPBIND"
S ZTDESC="PSB - Initialize Default Contingency Workstation"
S ZTIO="",ZTSAVE("ALPWKS")=""
I $D(ALPHLL) S ZTSAVE("ALPHLL(")=""
D ^%ZTLOAD
W:$D(ZTSK) !,ZTSK
K ZTIO,ZTDESC,ZTRTN,ZTSK
Q
EN ;Loop through the inpatient list.
Q:'$D(ALPHLL)
S ALPDTS=$$FMTE^XLFDT($$NOW^XLFDT)
K ALPSCR
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 ALPDIV=$P($G(^DIC(42,ALPCNI,0)),U,11)
. ;Check to see is the Division has Machines defined to it.
. ;if it does then it is not to go to default
. K ALPTEST
. D GET^ALPBPARM(.ALPTEST,ALPDIV,1)
. Q:$D(ALPTEST)
. S ALPSTOP=$$S^%ZTLOAD()
. S ALDFN=0
. F S ALDFN=$O(^DPT("CN",ALPCN,ALDFN)) Q:+ALDFN'>0!(ALPSTOP) D PAT
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
EXIT ;
K ALPDTS,ALPDTE,ALPCNT
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,ALPSLT,ALPWKS
K PID,PV1,^TMP("PSJ",$J),^TMP("PSJBU",$J)
;
Q
MLOG ;Need to loop though the Med log file to get all med logs
;associated with the order
Q:'$D(^PSB(53.79,"AORDX",ALDFN,ALPORDR))
S X=+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP MEDLG",1,"Q")
S X=$S(X>0:"T-"_X,1:"T-30")
D ^%DT
Q:+Y'>0 ;Cannot get a valid date
S ALPMDT=Y
F S ALPMDT=$O(^PSB(53.79,"AORDX",ALDFN,ALPORDR,ALPMDT)) Q:+ALPMDT'>0 D
. S ALPML=0
. F S ALPML=$O(^PSB(53.79,"AORDX",ALDFN,ALPORDR,ALPMDT,ALPML)) Q:+ALPML'>0 D
. . Q:+$P($G(^PSB(53.79,ALPML,0)),U,1)'>0 ; Bad Med-log
. . ;W !,ALPML
. . S ALPRSLT=$$MEDL^ALPBINP(ALPML)
Q
MESS ;BUILD AND SEND MESSAGE
K ALPB
D EN^PSJBCBU(ALDFN,ALPORDR,.ALPB)
S ALPBI=0
F S ALPBI=$O(ALPB(ALPBI)) Q:ALPBI'>0 D
. I $E(ALPB(ALPBI),1,3)="MSH" S MSH=ALPBI
. I $E(ALPB(ALPBI),1,3)="PID" S PID=ALPBI
. I $E(ALPB(ALPBI),1,3)="PV1" S PV1=ALPBI
. I $E(ALPB(ALPBI),1,3)="ORC" S ORC=ALPBI
I +MSH'>0 Q ;MISSING MSH SEGMENT BAD MESSAGE
S MSCTR=$E(ALPB(MSH),4,8),ALPORD=ALPORDR
S X=$$INI^ALPBINP()
Q
SNDPT ;Send a Single Patient
K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="PO^2:EM",DIR("A")="Select Patient "
D ^DIR
Q:$D(DIRUT)
Q:+Y'>0
;S ALDFN=10748
S ALDFN=+Y
W !!,"Please Hold On While I send the orders",!!
;
PAT ;
K ^TMP("PSJBU",$J)
S X=+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP IPH",1,"Q")
S X=$S(X>0:"T-"_X,1:"T-15")
D ^%DT
Q:+Y'>0 ;Cannot get a valid date
D EN2^PSJBCBU(ALDFN,Y)
Q:'$D(^TMP("PSJBU",$J)) ; NO DATA
S ALPBJ=0
F S ALPBJ=$O(^TMP("PSJBU",$J,ALPBJ)) Q:+ALPBJ'>0 D
. Q:'$D(^TMP("PSJBU",$J,ALPBJ,0))
. S ALPORDR=$P(^TMP("PSJBU",$J,ALPBJ,0),U,3)
. Q:+ALPORDR'>0
. D MESS
. Q:ALPORDR["P" ;If not pending do Med-Log
. D MLOG
S ALPSTOP=$$S^%ZTLOAD()
Q
ALPBIND ;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 ; EN^PSJBCBU/3876
+8 QUIT
OPT ;Entry point for the option
+1 ;Select Workstations assigned to Default.
DFT KILL ALPHLL,DIR,ALPDIV,DTOUT,DUOUT,DIRUT,DIROUT
+1 DO GET^ALPBPARM(.ALPHLL,"")
+2 IF '$DATA(ALPHLL)
WRITE !,"No workstations defined for default "
GOTO EXIT
+3 DO ALLWKS
+4 ;D:'$D(DIRUT) QUE
+5 DO QUE
+6 GOTO EXIT
+7 ;
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"
+5 DO ^DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET ALPWKS=+Y
+8 IF +ALPWKS>0
QUIT
+9 ;
WRKSTN ;Now select which workstations 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^ALPBIND"
+3 SET ZTDESC="PSB - Initialize Default Contingency Workstation"
+4 SET ZTIO=""
SET ZTSAVE("ALPWKS")=""
+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 IF '$DATA(ALPHLL)
QUIT
+2 SET ALPDTS=$$FMTE^XLFDT($$NOW^XLFDT)
+3 KILL ALPSCR
+4 SET ALPSTOP=0
SET ALPOK=1
+5 SET ALPCN=""
+6 FOR
SET ALPCN=$ORDER(^DPT("CN",ALPCN))
IF ALPCN=""!(ALPSTOP)
QUIT
Begin DoDot:1
+7 ;DIVISION SCREEN HERE
+8 SET ALPCNI=$ORDER(^DIC(42,"B",ALPCN,0))
+9 ;Quit if I can't decifer the Ward Location
IF +ALPCNI'>0
QUIT
+10 SET ALPDIV=$PIECE($GET(^DIC(42,ALPCNI,0)),U,11)
+11 ;Check to see is the Division has Machines defined to it.
+12 ;if it does then it is not to go to default
+13 KILL ALPTEST
+14 DO GET^ALPBPARM(.ALPTEST,ALPDIV,1)
+15 IF $DATA(ALPTEST)
QUIT
+16 SET ALPSTOP=$$S^%ZTLOAD()
+17 SET ALDFN=0
+18 FOR
SET ALDFN=$ORDER(^DPT("CN",ALPCN,ALDFN))
IF +ALDFN'>0!(ALPSTOP)
QUIT
DO PAT
End DoDot:1
+19 KILL XQA,XQAMSG
+20 SET ALPDTE=$$FMTE^XLFDT($$NOW^XLFDT)
+21 SET XQA(DUZ)=""
+22 SET XQAMSG="BCBU WORKSTATION INIT Started "_ALPDTS_" and finished "_ALPDTE_". "
+23 ;_ALPBK_" entries sent."
+24 DO SETUP^XQALERT
EXIT ;
+1 KILL ALPDTS,ALPDTE,ALPCNT
+2 KILL ALPB,ALPBI,ALPBJ,ALPCN,ALDFN,ALPMDT,ALPML,ALPORDR,MSCTR,MSH,ORC
+3 KILL PID,PV1,ALPHLL,ALPALL,DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT,ALPDIV
+4 KILL ALPTST,ALPSTOP,ALPOK,ZTSAVE,ALPCNI,ALPCNT,ALP,ALPDVN,ALPSLT,ALPWKS
+5 KILL PID,PV1,^TMP("PSJ",$JOB),^TMP("PSJBU",$JOB)
+6 ;
+7 QUIT
MLOG ;Need to loop though the Med log file to get all med logs
+1 ;associated with the order
+2 IF '$DATA(^PSB(53.79,"AORDX",ALDFN,ALPORDR))
QUIT
+3 SET X=+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP MEDLG",1,"Q")
+4 SET X=$SELECT(X>0:"T-"_X,1:"T-30")
+5 DO ^%DT
+6 ;Cannot get a valid date
IF +Y'>0
QUIT
+7 SET ALPMDT=Y
+8 FOR
SET ALPMDT=$ORDER(^PSB(53.79,"AORDX",ALDFN,ALPORDR,ALPMDT))
IF +ALPMDT'>0
QUIT
Begin DoDot:1
+9 SET ALPML=0
+10 FOR
SET ALPML=$ORDER(^PSB(53.79,"AORDX",ALDFN,ALPORDR,ALPMDT,ALPML))
IF +ALPML'>0
QUIT
Begin DoDot:2
+11 ; Bad Med-log
IF +$PIECE($GET(^PSB(53.79,ALPML,0)),U,1)'>0
QUIT
+12 ;W !,ALPML
+13 SET ALPRSLT=$$MEDL^ALPBINP(ALPML)
End DoDot:2
End DoDot:1
+14 QUIT
MESS ;BUILD AND SEND MESSAGE
+1 KILL ALPB
+2 DO EN^PSJBCBU(ALDFN,ALPORDR,.ALPB)
+3 SET ALPBI=0
+4 FOR
SET ALPBI=$ORDER(ALPB(ALPBI))
IF ALPBI'>0
QUIT
Begin DoDot:1
+5 IF $EXTRACT(ALPB(ALPBI),1,3)="MSH"
SET MSH=ALPBI
+6 IF $EXTRACT(ALPB(ALPBI),1,3)="PID"
SET PID=ALPBI
+7 IF $EXTRACT(ALPB(ALPBI),1,3)="PV1"
SET PV1=ALPBI
+8 IF $EXTRACT(ALPB(ALPBI),1,3)="ORC"
SET ORC=ALPBI
End DoDot:1
+9 ;MISSING MSH SEGMENT BAD MESSAGE
IF +MSH'>0
QUIT
+10 SET MSCTR=$EXTRACT(ALPB(MSH),4,8)
SET ALPORD=ALPORDR
+11 SET X=$$INI^ALPBINP()
+12 QUIT
SNDPT ;Send a Single Patient
+1 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="PO^2:EM"
SET DIR("A")="Select Patient "
+3 DO ^DIR
+4 IF $DATA(DIRUT)
QUIT
+5 IF +Y'>0
QUIT
+6 ;S ALDFN=10748
+7 SET ALDFN=+Y
+8 WRITE !!,"Please Hold On While I send the orders",!!
+9 ;
PAT ;
+1 KILL ^TMP("PSJBU",$JOB)
+2 SET X=+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP IPH",1,"Q")
+3 SET X=$SELECT(X>0:"T-"_X,1:"T-15")
+4 DO ^%DT
+5 ;Cannot get a valid date
IF +Y'>0
QUIT
+6 DO EN2^PSJBCBU(ALDFN,Y)
+7 ; NO DATA
IF '$DATA(^TMP("PSJBU",$JOB))
QUIT
+8 SET ALPBJ=0
+9 FOR
SET ALPBJ=$ORDER(^TMP("PSJBU",$JOB,ALPBJ))
IF +ALPBJ'>0
QUIT
Begin DoDot:1
+10 IF '$DATA(^TMP("PSJBU",$JOB,ALPBJ,0))
QUIT
+11 SET ALPORDR=$PIECE(^TMP("PSJBU",$JOB,ALPBJ,0),U,3)
+12 IF +ALPORDR'>0
QUIT
+13 DO MESS
+14 ;If not pending do Med-Log
IF ALPORDR["P"
QUIT
+15 DO MLOG
End DoDot:1
+16 SET ALPSTOP=$$S^%ZTLOAD()
+17 QUIT
