ALPBIND ;OIFO-DALLAS/SED/KC/MW BCMA-BCBU INPT TO HL7 INIT ;07/06/16 7:06am
;;3.0;BAR CODE MED ADMIN;**8,73,87,115**;Mar 2004;Build 3
;
; Reference/IA
; DPT/10035
; DIC(42/10039
; DIC(42/2440
; EN^PSJBCBU/3876
;
;*87 - Fix VistA Init by DIV option where Clinic orders will check if
; they point to DIV requested.
Q
OPT ;Entry point for the option
;Select Workstations assigned to Default.
DFT K ALPHLL,DIR,ALPDIV,DTOUT,DUOUT,DIRUT,DIROUT,ALPHLINI
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 ALPHLINI(ALPHLL("LINKS",ALPCNT))=""
. 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
S ZTRTN="EN^ALPBIND"
S ZTDESC="PSB - Initialize Default Contingency Workstation"
S ZTIO="",ZTSAVE("ALPWKS")=""
I $D(ALPHLL) S ZTSAVE("ALPHLL(")=""
I $D(ALPHLINI) S ZTSAVE("ALPHLINI(")=""
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 ;Ward Location(CN)
. ;DIVISION SCREEN HERE
. S ALPCNI=$O(^DIC(42,"B",ALPCN,0)) ;Ward Name(B)
. Q:+ALPCNI'>0 ;Quit if I can't decipher 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("") ;null selected Div param *87
;
N ALPNOWCL S ALPNOWCL=$$NOW^XLFDT()
D UDCLIN(ALPNOWCL,"") ;null selected Div par *87
D IVCLIN(ALPNOWCL,"") ;null selected Div par *87
;
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,ALPHLINI
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
. . 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=+Y
W !!,"Please Hold On While I send the orders",!!
D PAT("")
Q
;
PAT(ALPDIV2) ;Process and send patients ;add DIV par specl for DIV init *87
;New Div variable, reused in some downstream function calls ;*87
N ALPDIV
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
;
UDCLIN(ALPNOW,ALPDIV2) ; Unit Dose Clinic Orders ;*87
N ALPSEND,ALPCSTPD,ALPCN,ALPDFNAR S ALPCSTPD=ALPNOW
F S ALPCSTPD=$O(^PS(55,"AUDC",ALPCSTPD)) Q:ALPCSTPD="" S ALPCN="" F S ALPCN=$O(^PS(55,"AUDC",ALPCSTPD,ALPCN)) Q:ALPCN="" D
. ;DIVISION SCREEN
. Q:+ALPCN'>0 ;*87
. S ALPSEND=0 ;*87
. S ALPDIV=$P($G(^SC(ALPCN,0)),"^",15) ;*87
. ;Screen If DIV Init, If Clinic is in DIV send it. If ALPDIV2=0, ALL DIV was selected in ^ALPBIN ;*87
. S ALPSEND=$S(ALPDIV2&(ALPDIV2=ALPDIV):1,ALPDIV2=0:1,1:0) ;*87
. ;Check for DFT ;*87
. K ALPTEST
. D GET^ALPBPARM(.ALPTEST,ALPDIV,1)
. ;If Links defined and Init was not a Divisional init then Q ;*87
. Q:$D(ALPTEST)&($G(ALPSEND)=0) ;*87
. S ALPSTOP=$$S^%ZTLOAD()
. S ALDFN=0
. F S ALDFN=$O(^PS(55,"AUDC",ALPCSTPD,ALPCN,ALDFN)) Q:'ALDFN S ALPDFNAR(ALDFN)=""
S ALDFN=0
F S ALDFN=$O(ALPDFNAR(ALDFN)) Q:'ALDFN!$G(ALPSTOP) D PAT(ALPDIV2) ;pass Div par *87
Q
;
IVCLIN(ALPNOW,ALPDIV2) ; IV Clinic Orders
N ALPSEND,ALPCSTPD,ALPCN,ALPDFNAR S ALPCSTPD=ALPNOW
F S ALPCSTPD=$O(^PS(55,"AIVC",ALPCSTPD)) Q:ALPCSTPD="" S ALPCN="" F S ALPCN=$O(^PS(55,"AIVC",ALPCSTPD,ALPCN)) Q:ALPCN="" D
. ;DIVISION SCREEN
. Q:+ALPCN'>0 ;*87
. S ALPSEND=0 ;*87
. S ALPDIV=$P($G(^SC(ALPCN,0)),"^",15) ;*87
. ;Screen If DIV Init, If Clinic is in DIV send it. If ALPDIV2=0, ALL DIV was selected in ^ALPBIN ;*87
. S ALPSEND=$S(ALPDIV2&(ALPDIV2=ALPDIV):1,ALPDIV2=0:1,1:0) ;*87
. ;Check for DFT ;*87
. K ALPTEST
. D GET^ALPBPARM(.ALPTEST,ALPDIV,1)
. ;If Links defined and Init was not a Divisional init then Q ;*87
. Q:$D(ALPTEST)&($G(ALPSEND)=0) ;*87
. S ALPSTOP=$$S^%ZTLOAD()
. S ALDFN=0
. F S ALDFN=$O(^PS(55,"AIVC",ALPCSTPD,ALPCN,ALDFN)) Q:'ALDFN S ALPDFNAR(ALDFN)=""
S ALDFN=0
F S ALDFN=$O(ALPDFNAR(ALDFN)) Q:'ALDFN!$G(ALPSTOP) D PAT(ALPDIV2) ;pass Div par *87
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBIND 7752 printed Apr 09, 2024@20:44:57 Page 2
ALPBIND ;OIFO-DALLAS/SED/KC/MW BCMA-BCBU INPT TO HL7 INIT ;07/06/16 7:06am
+1 ;;3.0;BAR CODE MED ADMIN;**8,73,87,115**;Mar 2004;Build 3
+2 ;
+3 ; Reference/IA
+4 ; DPT/10035
+5 ; DIC(42/10039
+6 ; DIC(42/2440
+7 ; EN^PSJBCBU/3876
+8 ;
+9 ;*87 - Fix VistA Init by DIV option where Clinic orders will check if
+10 ; they point to DIV requested.
+11 QUIT
OPT ;Entry point for the option
+1 ;Select Workstations assigned to Default.
DFT KILL ALPHLL,DIR,ALPDIV,DTOUT,DUOUT,DIRUT,DIROUT,ALPHLINI
+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 ALPHLINI(ALPHLL("LINKS",ALPCNT))=""
+14 SET ALPCNT=ALPCNT+1
End DoDot:1
+15 KILL ALPSCRN,ALPBANS
+16 QUIT
+17 ;
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 SET ZTRTN="EN^ALPBIND"
+2 SET ZTDESC="PSB - Initialize Default Contingency Workstation"
+3 SET ZTIO=""
SET ZTSAVE("ALPWKS")=""
+4 IF $DATA(ALPHLL)
SET ZTSAVE("ALPHLL(")=""
+5 IF $DATA(ALPHLINI)
SET ZTSAVE("ALPHLINI(")=""
+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 ;Ward Location(CN)
FOR
SET ALPCN=$ORDER(^DPT("CN",ALPCN))
if ALPCN=""!(ALPSTOP)
QUIT
Begin DoDot:1
+7 ;DIVISION SCREEN HERE
+8 ;Ward Name(B)
SET ALPCNI=$ORDER(^DIC(42,"B",ALPCN,0))
+9 ;Quit if I can't decipher 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 ;null selected Div param *87
FOR
SET ALDFN=$ORDER(^DPT("CN",ALPCN,ALDFN))
if +ALDFN'>0!(ALPSTOP)
QUIT
DO PAT("")
End DoDot:1
+19 ;
+20 NEW ALPNOWCL
SET ALPNOWCL=$$NOW^XLFDT()
+21 ;null selected Div par *87
DO UDCLIN(ALPNOWCL,"")
+22 ;null selected Div par *87
DO IVCLIN(ALPNOWCL,"")
+23 ;
+24 KILL XQA,XQAMSG
+25 SET ALPDTE=$$FMTE^XLFDT($$NOW^XLFDT)
+26 SET XQA(DUZ)=""
+27 SET XQAMSG="BCBU WORKSTATION INIT Started "_ALPDTS_" and finished "_ALPDTE_". "
+28 ;_ALPBK_" entries sent."
+29 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,ALPHLINI
+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 SET ALPRSLT=$$MEDL^ALPBINP(ALPML)
End DoDot:2
End DoDot:1
+13 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 SET ALDFN=+Y
+7 WRITE !!,"Please Hold On While I send the orders",!!
+8 DO PAT("")
+9 QUIT
+10 ;
PAT(ALPDIV2) ;Process and send patients ;add DIV par specl for DIV init *87
+1 ;New Div variable, reused in some downstream function calls ;*87
+2 NEW ALPDIV
+3 KILL ^TMP("PSJBU",$JOB)
+4 SET X=+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP IPH",1,"Q")
+5 SET X=$SELECT(X>0:"T-"_X,1:"T-15")
+6 DO ^%DT
+7 ;Cannot get a valid date
if +Y'>0
QUIT
+8 DO EN2^PSJBCBU(ALDFN,Y)
+9 ; NO DATA
if '$DATA(^TMP("PSJBU",$JOB))
QUIT
+10 SET ALPBJ=0
+11 FOR
SET ALPBJ=$ORDER(^TMP("PSJBU",$JOB,ALPBJ))
if +ALPBJ'>0
QUIT
Begin DoDot:1
+12 if '$DATA(^TMP("PSJBU",$JOB,ALPBJ,0))
QUIT
+13 SET ALPORDR=$PIECE(^TMP("PSJBU",$JOB,ALPBJ,0),U,3)
+14 if +ALPORDR'>0
QUIT
+15 DO MESS
+16 ;If not pending do Med-Log
if ALPORDR["P"
QUIT
+17 DO MLOG
End DoDot:1
+18 SET ALPSTOP=$$S^%ZTLOAD()
+19 QUIT
+20 ;
UDCLIN(ALPNOW,ALPDIV2) ; Unit Dose Clinic Orders ;*87
+1 NEW ALPSEND,ALPCSTPD,ALPCN,ALPDFNAR
SET ALPCSTPD=ALPNOW
+2 FOR
SET ALPCSTPD=$ORDER(^PS(55,"AUDC",ALPCSTPD))
if ALPCSTPD=""
QUIT
SET ALPCN=""
FOR
SET ALPCN=$ORDER(^PS(55,"AUDC",ALPCSTPD,ALPCN))
if ALPCN=""
QUIT
Begin DoDot:1
+3 ;DIVISION SCREEN
+4 ;*87
if +ALPCN'>0
QUIT
+5 ;*87
SET ALPSEND=0
+6 ;*87
SET ALPDIV=$PIECE($GET(^SC(ALPCN,0)),"^",15)
+7 ;Screen If DIV Init, If Clinic is in DIV send it. If ALPDIV2=0, ALL DIV was selected in ^ALPBIN ;*87
+8 ;*87
SET ALPSEND=$SELECT(ALPDIV2&(ALPDIV2=ALPDIV):1,ALPDIV2=0:1,1:0)
+9 ;Check for DFT ;*87
+10 KILL ALPTEST
+11 DO GET^ALPBPARM(.ALPTEST,ALPDIV,1)
+12 ;If Links defined and Init was not a Divisional init then Q ;*87
+13 ;*87
if $DATA(ALPTEST)&($GET(ALPSEND)=0)
QUIT
+14 SET ALPSTOP=$$S^%ZTLOAD()
+15 SET ALDFN=0
+16 FOR
SET ALDFN=$ORDER(^PS(55,"AUDC",ALPCSTPD,ALPCN,ALDFN))
if 'ALDFN
QUIT
SET ALPDFNAR(ALDFN)=""
End DoDot:1
+17 SET ALDFN=0
+18 ;pass Div par *87
FOR
SET ALDFN=$ORDER(ALPDFNAR(ALDFN))
if 'ALDFN!$GET(ALPSTOP)
QUIT
DO PAT(ALPDIV2)
+19 QUIT
+20 ;
IVCLIN(ALPNOW,ALPDIV2) ; IV Clinic Orders
+1 NEW ALPSEND,ALPCSTPD,ALPCN,ALPDFNAR
SET ALPCSTPD=ALPNOW
+2 FOR
SET ALPCSTPD=$ORDER(^PS(55,"AIVC",ALPCSTPD))
if ALPCSTPD=""
QUIT
SET ALPCN=""
FOR
SET ALPCN=$ORDER(^PS(55,"AIVC",ALPCSTPD,ALPCN))
if ALPCN=""
QUIT
Begin DoDot:1
+3 ;DIVISION SCREEN
+4 ;*87
if +ALPCN'>0
QUIT
+5 ;*87
SET ALPSEND=0
+6 ;*87
SET ALPDIV=$PIECE($GET(^SC(ALPCN,0)),"^",15)
+7 ;Screen If DIV Init, If Clinic is in DIV send it. If ALPDIV2=0, ALL DIV was selected in ^ALPBIN ;*87
+8 ;*87
SET ALPSEND=$SELECT(ALPDIV2&(ALPDIV2=ALPDIV):1,ALPDIV2=0:1,1:0)
+9 ;Check for DFT ;*87
+10 KILL ALPTEST
+11 DO GET^ALPBPARM(.ALPTEST,ALPDIV,1)
+12 ;If Links defined and Init was not a Divisional init then Q ;*87
+13 ;*87
if $DATA(ALPTEST)&($GET(ALPSEND)=0)
QUIT
+14 SET ALPSTOP=$$S^%ZTLOAD()
+15 SET ALDFN=0
+16 FOR
SET ALDFN=$ORDER(^PS(55,"AIVC",ALPCSTPD,ALPCN,ALDFN))
if 'ALDFN
QUIT
SET ALPDFNAR(ALDFN)=""
End DoDot:1
+17 SET ALDFN=0
+18 ;pass Div par *87
FOR
SET ALDFN=$ORDER(ALPDFNAR(ALDFN))
if 'ALDFN!$GET(ALPSTOP)
QUIT
DO PAT(ALPDIV2)
+19 QUIT
