Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ALPBIND

ALPBIND.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference/IA
  1.  ; DPT/10035
  1.  ; DIC(42/10039
  1.  ; DIC(42/2440
  1.  ; EN^PSJBCBU/3876
  1.  Q
  1. OPT ;Entry point for the option
  1.  ;Select Workstations assigned to Default.
  1. DFT K ALPHLL,DIR,ALPDIV,DTOUT,DUOUT,DIRUT,DIROUT
  1.  D GET^ALPBPARM(.ALPHLL,"")
  1.  I '$D(ALPHLL) W !,"No workstations defined for default " G EXIT
  1.  D ALLWKS
  1.  ;D:'$D(DIRUT) QUE
  1.  D QUE
  1.  G EXIT
  1.  ;
  1. ALLWKS ;If no then set allow the user to select the workstation
  1.  K DTOUT,DUOUT,DIRUT,DIROUT,DIR
  1.  S DIR(0)="Y",DIR("B")="YES"
  1.  S DIR("A")="Enter Yes or No"
  1.  S DIR("A",1)="Include all workstations"
  1.  D ^DIR
  1.  I $D(DIRUT) Q
  1.  S ALPWKS=+Y
  1.  I +ALPWKS>0 Q
  1.  ;
  1. WRKSTN ;Now select which workstations to be initialized
  1.  K ALPSCRN,ALPBANS
  1.  ;Set up screen
  1.  S ALP=0 F  S ALP=$O(ALPHLL("LINKS",ALP))  Q:+ALP'>0  D
  1.  . S ALPSCRN($P(ALPHLL("LINKS",ALP),U,2),ALP)=ALPHLL("LINKS",ALP)
  1.  K ALPHLL
  1.  F  D LP Q:$D(DIRUT)
  1.  ;I $D(DIRUT)&($D(ALPHLL)) W !!,"No Selected Workstations" G ALLWKS
  1.  I '$D(ALPBANS)!$D(ALPHLL) W !!,"No Selected Workstations" G ALLWKS
  1.  Q:'$D(ALPBANS)
  1.  S ALP="",ALPCNT=1
  1.  F  S ALP=$O(ALPBANS(ALP)) Q:ALP=""  D
  1.  . S ALPHLL("LINKS",ALPCNT)=ALPSCRN(ALP,$O(ALPSCRN(ALP,0)))
  1.  . S ALPCNT=ALPCNT+1
  1.  K ALPSCRN,ALPBANS
  1.  Q
  1.  ;
  1. LP ;Multiple entries
  1.  K DIR,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR(0)="PO^870:EMZ",DIR("A")="Select WorkStation Link "
  1.  S DIR("?")="Answer with WorkStation Link to update "
  1.  S DIR("S")="I $D(ALPSCRN($P(^HLCS(870,+Y,0),U,1)))"
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  S ALPBANS($P(Y,U,2),+Y)=""
  1.  W #,!!,"Selected Workstations",!!
  1.  S ALPB=""
  1.  F ALP=1:1 S ALPB=$O(ALPBANS(ALPB)) Q:ALPB=""  D
  1.  .W ?$S(ALP#2:1,1:40),ALPB
  1.  .W:ALP#2'>0 !
  1.  Q
  1.  ;
  1. QUE ;Que the job
  1.  ;W !,"QUE"
  1.  S ZTRTN="EN^ALPBIND"
  1.  S ZTDESC="PSB - Initialize Default Contingency Workstation"
  1.  S ZTIO="",ZTSAVE("ALPWKS")=""
  1.  I $D(ALPHLL) S ZTSAVE("ALPHLL(")=""
  1.  D ^%ZTLOAD
  1.  W:$D(ZTSK) !,ZTSK
  1.  K ZTIO,ZTDESC,ZTRTN,ZTSK
  1.  Q
  1. EN ;Loop through the inpatient list.
  1.  Q:'$D(ALPHLL)
  1.  S ALPDTS=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  K ALPSCR
  1.  S ALPSTOP=0,ALPOK=1
  1.  S ALPCN=""
  1.  F  S ALPCN=$O(^DPT("CN",ALPCN)) Q:ALPCN=""!(ALPSTOP)  D
  1.  . ;DIVISION SCREEN HERE
  1.  . S ALPCNI=$O(^DIC(42,"B",ALPCN,0))
  1.  . Q:+ALPCNI'>0  ;Quit if I can't decifer the Ward Location
  1.  . S ALPDIV=$P($G(^DIC(42,ALPCNI,0)),U,11)
  1.  . ;Check to see is the Division has Machines defined to it.
  1.  . ;if it does then it is not to go to default
  1.  . K ALPTEST
  1.  . D GET^ALPBPARM(.ALPTEST,ALPDIV,1)
  1.  . Q:$D(ALPTEST)
  1.  . S ALPSTOP=$$S^%ZTLOAD()
  1.  . S ALDFN=0
  1.  . F  S ALDFN=$O(^DPT("CN",ALPCN,ALDFN)) Q:+ALDFN'>0!(ALPSTOP)  D PAT
  1.  K XQA,XQAMSG
  1.  S ALPDTE=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S XQA(DUZ)=""
  1.  S XQAMSG="BCBU WORKSTATION INIT Started "_ALPDTS_" and finished "_ALPDTE_". "
  1.  ;_ALPBK_" entries sent."
  1.  D SETUP^XQALERT
  1. EXIT ;
  1.  K ALPDTS,ALPDTE,ALPCNT
  1.  K ALPB,ALPBI,ALPBJ,ALPCN,ALDFN,ALPMDT,ALPML,ALPORDR,MSCTR,MSH,ORC
  1.  K PID,PV1,ALPHLL,ALPALL,DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT,ALPDIV
  1.  K ALPTST,ALPSTOP,ALPOK,ZTSAVE,ALPCNI,ALPCNT,ALP,ALPDVN,ALPSLT,ALPWKS
  1.  K PID,PV1,^TMP("PSJ",$J),^TMP("PSJBU",$J)
  1.  ;
  1.  Q
  1. MLOG ;Need to loop though the Med log file to get all med logs
  1.  ;associated with the order
  1.  Q:'$D(^PSB(53.79,"AORDX",ALDFN,ALPORDR))
  1.  S X=+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP MEDLG",1,"Q")
  1.  S X=$S(X>0:"T-"_X,1:"T-30")
  1.  D ^%DT
  1.  Q:+Y'>0  ;Cannot get a valid date
  1.  S ALPMDT=Y
  1.  F  S ALPMDT=$O(^PSB(53.79,"AORDX",ALDFN,ALPORDR,ALPMDT)) Q:+ALPMDT'>0  D
  1.  . S ALPML=0
  1.  . F  S ALPML=$O(^PSB(53.79,"AORDX",ALDFN,ALPORDR,ALPMDT,ALPML)) Q:+ALPML'>0  D
  1.  . . Q:+$P($G(^PSB(53.79,ALPML,0)),U,1)'>0  ; Bad Med-log
  1.  . . ;W !,ALPML
  1.  . . S ALPRSLT=$$MEDL^ALPBINP(ALPML)
  1.  Q
  1. MESS ;BUILD AND SEND MESSAGE
  1.  K ALPB
  1.  D EN^PSJBCBU(ALDFN,ALPORDR,.ALPB)
  1.  S ALPBI=0
  1.  F  S ALPBI=$O(ALPB(ALPBI)) Q:ALPBI'>0  D
  1.  . I $E(ALPB(ALPBI),1,3)="MSH" S MSH=ALPBI
  1.  . I $E(ALPB(ALPBI),1,3)="PID" S PID=ALPBI
  1.  . I $E(ALPB(ALPBI),1,3)="PV1" S PV1=ALPBI
  1.  . I $E(ALPB(ALPBI),1,3)="ORC" S ORC=ALPBI
  1.  I +MSH'>0 Q   ;MISSING MSH SEGMENT BAD MESSAGE
  1.  S MSCTR=$E(ALPB(MSH),4,8),ALPORD=ALPORDR
  1.  S X=$$INI^ALPBINP()
  1.  Q
  1. SNDPT ;Send a Single Patient
  1.  K DIR,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR(0)="PO^2:EM",DIR("A")="Select Patient "
  1.  D ^DIR
  1.  Q:$D(DIRUT)
  1.  Q:+Y'>0
  1.  ;S ALDFN=10748
  1.  S ALDFN=+Y
  1.  W !!,"Please Hold On While I send the orders",!!
  1.  ;
  1. PAT ;
  1.  K ^TMP("PSJBU",$J)
  1.  S X=+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP IPH",1,"Q")
  1.  S X=$S(X>0:"T-"_X,1:"T-15")
  1.  D ^%DT
  1.  Q:+Y'>0  ;Cannot get a valid date
  1.  D EN2^PSJBCBU(ALDFN,Y)
  1.  Q:'$D(^TMP("PSJBU",$J))  ; NO DATA
  1.  S ALPBJ=0
  1.  F  S ALPBJ=$O(^TMP("PSJBU",$J,ALPBJ)) Q:+ALPBJ'>0  D
  1.  . Q:'$D(^TMP("PSJBU",$J,ALPBJ,0))
  1.  . S ALPORDR=$P(^TMP("PSJBU",$J,ALPBJ,0),U,3)
  1.  . Q:+ALPORDR'>0
  1.  . D MESS
  1.  . Q:ALPORDR["P"  ;If not pending do Med-Log
  1.  . D MLOG
  1.  S ALPSTOP=$$S^%ZTLOAD()
  1.  Q