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

PSJEEU.m

Go to the documentation of this file.
  1. PSJEEU ;BIR/CML3-EXTERNAL ENTRIES UTILITY ; 9/10/09 10:46am
  1. ;;5.0;INPATIENT MEDICATIONS ;**3,208,232,283**;16 DEC 97;Build 4
  1. ;
  1. ENSV ; schedule validation
  1. ;K PSJAT,PSJM I $S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$D(^DIC(9.4,"C",PSJPP))) Q
  1. ; changed to remove ref to 9.4,"C"
  1. K PSJAT,PSJM Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:0) N DIC S X=PSJPP,DIC(0)="OX",DIC=9.4,D="C" D IX^DIC I +Y'>0 Q
  1. Q:$D(PSJX)[0 I $D(PSJW),$S('PSJW:1,1:'$D(^SC(PSJW,0))) K PSJW
  1. N D,DIC,DIE,Q,QX,SDW,SWD,X,X0,X1,X2,XT,Y,Z D EN^PSJSV Q
  1. ;
  1. ENSVI ; standard schedule inquire
  1. Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:0) S X=PSJPP,DIC(0)="OX",DIC=9.4,D="C" D IX^DIC I +Y'>0 Q
  1. D ENI^PSJSV0
  1. Q
  1. ;
  1. ENSPU ; schedule processor (count)
  1. K PSJC S PSJC=-1 I $S('$D(PSJAT):1,'$D(PSJM):1,'$D(PSJSCH):1,'$D(PSJSD):1,1:'$D(PSJFD)) Q
  1. ;the following line is for lab order with no start time PSJ*5.0*208
  1. I PSJPP="LR",PSJSD'["." D
  1. . N XPSJSD
  1. . S XPSJSD=PSJSD
  1. . ;*283 - Calculate start time
  1. . I PSJSD=DT S PSJSD=$$NOW^XLFDT()
  1. . I ORDUR S PSJFD=$$FMADD^XLFDT(PSJSD,+ORDUR,,-1) ; Calculate the new stopdate/time based on the new start date/time
  1. . I 'ORDUR S X=+$E(ORDUR,2,9) D
  1. .. I PSJM S PSJFD=$$FMADD^XLFDT(PSJSD,,,(PSJM*X)-1) Q ;X_#times
  1. .. ;no freq in minutes --> day of week
  1. .. N DAYS,LOCMX,SCHMX
  1. .. S LOCMX=$$GET^XPAR("ALL^LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q")
  1. .. S SCHMX=$P(^PS(51.1,PSJY,0),U,7)
  1. .. S DAYS=$S('SCHMX:LOCMX,LOCMX<SCHMX:LOCMX,1:SCHMX)
  1. .. S PSJFD=$$FMADD^XLFDT(PSJSD,DAYS,,-1)
  1. S:'$D(PSJOSD) PSJOSD=PSJSD S:'$D(PSJOFD) PSJOFD=PSJFD N AM,CD,H,HCD,I,J,M,MID,OD,PDL,PLSD,ST,Q,QQ,WD,WDT,WS,WS1,X,X1,X2,XX D EN^PSJSPU Q
  1. ;
  1. ENPSJSE ; schedule edit for Inpatient Meds
  1. S PSJPP="PSJ"
  1. ;
  1. ENSE ; schedule edit
  1. ;I $S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$D(^DIC(9.4,"C",PSJPP))) Q
  1. ; changed to remove ref to 9.4,"C"
  1. Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:0) S X=PSJPP,DIC(0)="OX",DIC=9.4,D="C" D IX^DIC I +Y'>0 Q
  1. I $D(PSJW),$S('PSJW:1,1:'$D(^SC(PSJW,0))) K PSJW
  1. F FQ=0:0 K DIC S DIC="^PS(51.1,",DIC(0)="QEASL",DIC("DR")="4////"_PSJPP,DIC("W")="D DICW^PSSJSV0",D="AP"_PSJPP W ! D IX^DIC K DIC Q:Y'>0 S DIE="^PS(51.1,",DA=+Y,DR="[PSSJ "_$S(PSJPP="PSJ":"",1:"EXT ")_"SCHEDULE EDIT]" D ^DIE K DA,DIE,DR,PSJS
  1. K:PSJPP="PSJ" PSJPP K D0,DI,DISYS,DQ,FQ,X,Y
  1. Q
  1. ;
  1. ENDSD ; default start date
  1. I $S('$D(PSJSCH):1,'$D(PSJAT):1,1:'$D(PSJTS)) S PSJX="" Q
  1. D ENDSD^PSJSPU0 Q
  1. ;
  1. ENPSJSHE ; shift edit for Inpatient Meds
  1. S PSJPP="PSJ"
  1. ;
  1. ENSHE ; shift edit
  1. ;I $S('$D(PSJPP):1,PSJPP="":1,PSJPP'?.ANP:1,1:'$D(^DIC(9.4,"C",PSJPP))) Q
  1. ; changed to remove ref to 9.4,"C"
  1. Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP'?.ANP:1,1:0) S X=PSJPP,DIC(0)="OX",DIC=9.4,D="C" D IX^DIC I +Y'>0 Q
  1. I $D(PSJW),$S('PSJW:1,1:'$D(^SC(PSJW,0))) K PSJW
  1. F FQ=0:0 K DIC S DIC="^PS(51.15,",DIC(0)="AEQLS",DIC("DR")="4////"_PSJPP,D="AP"_PSJPP W ! D IX^DIC K DIC Q:Y'>0 S DIE="^PS(51.15,",DA=+Y,DR="[PSJ SHIFT EDIT]" D ^DIE K DA,DIE,DR
  1. K FQ,X,Y Q
  1. ;
  1. ENATV ; validate admin times
  1. D ENCHK^PSJSV Q
  1. ;
  1. ENSHV ;
  1. D ENSHV^PSJSV Q