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