PSSJEEU ;BIR/CML3,WRT-EXTERNAL ENTRIES UTILITY ; 09/16/97 10:04
;;1.0;PHARMACY DATA MANAGEMENT;**24,47,160,184,201,210**;9/30/97;Build 9
;
;Reference to ^SC(IEN,0 supported by DBIA #10040
;
ENSV ; schedule validation
N PSSPKG
I $D(PSJPP) K PSSPKG S PSSPKG=$$FIND1^DIC(9.4,"","O",PSJPP,"C")
K PSJAT,PSJM I $S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$G(PSSPKG)) 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^PSSJSV Q
;
ENSVI ; standard schedule inquire
N PSSPKG
I $D(PSJPP) K PSSPKG S PSSPKG=$$FIND1^DIC(9.4,"","O","PSJPP","C")
Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$G(PSSPKG)) D ENI^PSSJSV0
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
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^PSSJSPU Q
;
ENPSJSE ; schedule edit for Inpatient Meds
S PSJPP="PSJ" N PSSTSVZP,PSSTSVXP,PSSTSVXX,PSSTSVYY,PSSTSVZZ,PSSTSVZ1,PSSTSVX1,PSSTSVX2,PSSTSVY1,PSSTSVZ2,PSSDOW
;
ENSE ; schedule edit
N PSSPKG,PSSON,DICATTZ SET PSSON=""
I $D(PSJPP) K PSSPKG S PSSPKG=$$FIND1^DIC(9.4,"","O",PSJPP,"C")
I $S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$G(PSSPKG)) Q
I $D(PSJW),$S('PSJW:1,1:'$D(^SC(PSJW,0))) K PSJW
F FQ=0:0 K DIC S DICATTZ=1,DIC="^PS(51.1,",DIC(0)="EASL",DLAYGO=51.1,DIC("DR")="4////"_PSJPP,DIC("W")="D DICW^PSSJSV0",D="AP"_PSJPP W ! D IX^DIC K DIC Q:Y'>0 D
.S PSSON=$$UP^XLFSTR($P($G(Y),U,2))
.S DIE="^PS(51.1,",DA=+Y,DR="[PSSJ "_$S(PSJPP="PSJ":"",1:"EXT ")_"SCHEDULE EDIT]",DIE("NO^")="OUTOK" D ^DIE K DA,DIE,DR,PSJS
;* I $D(PSJHLDA) S X=$O(^ORD(101,"B","PS EVSEND SCH",0))_";ORD(101," D:X EN1^XQOR
I $D(PSJHLDA) D EN2^PSSHLSCH
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^PSSJSPU0 Q
;
ENPSJSHE ; shift edit for Inpatient Meds
S PSJPP="PSJ"
;
ENSHE ; shift edit
N PSSPKG
I $D(PSJPP) K PSSPKG S PSSPKG=$$FIND1^DIC(9.4,"","O",PSJPP,"C")
I $S('$D(PSJPP):1,PSJPP="":1,PSJPP'?.ANP:1,1:'$G(PSSPKG)) 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",DLAYGO=51.15,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,PSSPKG,X,Y Q
;
ENATV ; validate admin times
D ENCHK^PSSJSV Q
;
ENSHV ;
D ENSHV^PSSJSV
Q
OTHLAN ;entry point to add translations for another language
K DIK,DIC,DIRUT,DIE,DA,DR
S DIE="^PS(59.7,",DA=1,DR="40.2;S:'$G(X) Y=""@1"";40.21:40.45;@1"
D ^DIE K DIE,DA,X,Y,DR,DIC,D,D0,DDER,DI,DQ,%
Q
;
;
TEMSF ;Template saves, called form the PSSJ SCHEDULE EDIT template
I $D(X) S PSSTSVXX=X
I $D(Y) S PSSTSVYY=Y
I $D(PSJS) S PSSTSVZZ=PSJS
I $D(ZPSJS) S PSSTSVZP=ZPSJS
I $D(XPSJS) S PSSTSVXP=XPSJS
Q
;
TEMSFR ;Template restores called from the PSSJ SCHEDULE EDIT template
K X,Y,PSJS,ZPSJS,XPSJS
I $D(PSSTSVXX) S X=PSSTSVXX
I $D(PSSTSVYY) S Y=PSSTSVYY
I $D(PSSTSVZZ) S PSJS=PSSTSVZZ
I $D(PSSTSVZP) S ZPSJS=PSSTSVZP
I $D(PSSTSVXP) S XPSJS=PSSTSVXP
Q
;
;
TEMSFX ;Template saves, called form the PSSJ SCHEDULE EDIT template
I $D(X) S PSSTSVX1=X
I $D(Y) S PSSTSVY1=Y
I $D(PSJS) S PSSTSVZ1=PSJS
I $D(ZPSJS) S PSSTSVZ2=ZPSJS
I $D(XPSJS) S PSSTSVX2=XPSJS
Q
;
TEMSFRX ;Template restores called from the PSSJ SCHEDULE EDIT template
K X,Y,PSJS,ZPSJS,XPSJS
I $D(PSSTSVX1) S X=PSSTSVX1
I $D(PSSTSVY1) S Y=PSSTSVY1
I $D(PSSTSVZ1) S PSJS=PSSTSVZ1
I $D(PSSTSVZ2) S ZPSJS=PSSTSVZ2
I $D(PSSTSVX2) S XPSJS=PSSTSVX2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSJEEU 3738 printed Oct 16, 2024@18:32:50 Page 2
PSSJEEU ;BIR/CML3,WRT-EXTERNAL ENTRIES UTILITY ; 09/16/97 10:04
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**24,47,160,184,201,210**;9/30/97;Build 9
+2 ;
+3 ;Reference to ^SC(IEN,0 supported by DBIA #10040
+4 ;
ENSV ; schedule validation
+1 NEW PSSPKG
+2 IF $DATA(PSJPP)
KILL PSSPKG
SET PSSPKG=$$FIND1^DIC(9.4,"","O",PSJPP,"C")
+3 KILL PSJAT,PSJM
IF $SELECT('$DATA(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$GET(PSSPKG))
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^PSSJSV
QUIT
+6 ;
ENSVI ; standard schedule inquire
+1 NEW PSSPKG
+2 IF $DATA(PSJPP)
KILL PSSPKG
SET PSSPKG=$$FIND1^DIC(9.4,"","O","PSJPP","C")
+3 if $SELECT('$DATA(PSJPP)
QUIT
DO ENI^PSSJSV0
+4 QUIT
+5 ;
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 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^PSSJSPU
QUIT
+3 ;
ENPSJSE ; schedule edit for Inpatient Meds
+1 SET PSJPP="PSJ"
NEW PSSTSVZP,PSSTSVXP,PSSTSVXX,PSSTSVYY,PSSTSVZZ,PSSTSVZ1,PSSTSVX1,PSSTSVX2,PSSTSVY1,PSSTSVZ2,PSSDOW
+2 ;
ENSE ; schedule edit
+1 NEW PSSPKG,PSSON,DICATTZ
SET PSSON=""
+2 IF $DATA(PSJPP)
KILL PSSPKG
SET PSSPKG=$$FIND1^DIC(9.4,"","O",PSJPP,"C")
+3 IF $SELECT('$DATA(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$GET(PSSPKG))
QUIT
+4 IF $DATA(PSJW)
IF $SELECT('PSJW:1,1:'$DATA(^SC(PSJW,0)))
KILL PSJW
+5 FOR FQ=0:0
KILL DIC
SET DICATTZ=1
SET DIC="^PS(51.1,"
SET DIC(0)="EASL"
SET DLAYGO=51.1
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
Begin DoDot:1
+6 SET PSSON=$$UP^XLFSTR($PIECE($GET(Y),U,2))
+7 SET DIE="^PS(51.1,"
SET DA=+Y
SET DR="[PSSJ "_$SELECT(PSJPP="PSJ":"",1:"EXT ")_"SCHEDULE EDIT]"
SET DIE("NO^")="OUTOK"
DO ^DIE
KILL DA,DIE,DR,PSJS
End DoDot:1
+8 ;* I $D(PSJHLDA) S X=$O(^ORD(101,"B","PS EVSEND SCH",0))_";ORD(101," D:X EN1^XQOR
+9 IF $DATA(PSJHLDA)
DO EN2^PSSHLSCH
+10 if PSJPP="PSJ"
KILL PSJPP
KILL D0,DI,DISYS,DQ,FQ,X,Y
QUIT
+11 ;
ENDSD ; default start date
+1 IF $SELECT('$DATA(PSJSCH):1,'$DATA(PSJAT):1,1:'$DATA(PSJTS))
SET PSJX=""
QUIT
+2 DO ENDSD^PSSJSPU0
QUIT
+3 ;
ENPSJSHE ; shift edit for Inpatient Meds
+1 SET PSJPP="PSJ"
+2 ;
ENSHE ; shift edit
+1 NEW PSSPKG
+2 IF $DATA(PSJPP)
KILL PSSPKG
SET PSSPKG=$$FIND1^DIC(9.4,"","O",PSJPP,"C")
+3 IF $SELECT('$DATA(PSJPP):1,PSJPP="":1,PSJPP'?.ANP:1,1:'$GET(PSSPKG))
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 DLAYGO=51.15
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,PSSPKG,X,Y
QUIT
+7 ;
ENATV ; validate admin times
+1 DO ENCHK^PSSJSV
QUIT
+2 ;
ENSHV ;
+1 DO ENSHV^PSSJSV
+2 QUIT
OTHLAN ;entry point to add translations for another language
+1 KILL DIK,DIC,DIRUT,DIE,DA,DR
+2 SET DIE="^PS(59.7,"
SET DA=1
SET DR="40.2;S:'$G(X) Y=""@1"";40.21:40.45;@1"
+3 DO ^DIE
KILL DIE,DA,X,Y,DR,DIC,D,D0,DDER,DI,DQ,%
+4 QUIT
+5 ;
+6 ;
TEMSF ;Template saves, called form the PSSJ SCHEDULE EDIT template
+1 IF $DATA(X)
SET PSSTSVXX=X
+2 IF $DATA(Y)
SET PSSTSVYY=Y
+3 IF $DATA(PSJS)
SET PSSTSVZZ=PSJS
+4 IF $DATA(ZPSJS)
SET PSSTSVZP=ZPSJS
+5 IF $DATA(XPSJS)
SET PSSTSVXP=XPSJS
+6 QUIT
+7 ;
TEMSFR ;Template restores called from the PSSJ SCHEDULE EDIT template
+1 KILL X,Y,PSJS,ZPSJS,XPSJS
+2 IF $DATA(PSSTSVXX)
SET X=PSSTSVXX
+3 IF $DATA(PSSTSVYY)
SET Y=PSSTSVYY
+4 IF $DATA(PSSTSVZZ)
SET PSJS=PSSTSVZZ
+5 IF $DATA(PSSTSVZP)
SET ZPSJS=PSSTSVZP
+6 IF $DATA(PSSTSVXP)
SET XPSJS=PSSTSVXP
+7 QUIT
+8 ;
+9 ;
TEMSFX ;Template saves, called form the PSSJ SCHEDULE EDIT template
+1 IF $DATA(X)
SET PSSTSVX1=X
+2 IF $DATA(Y)
SET PSSTSVY1=Y
+3 IF $DATA(PSJS)
SET PSSTSVZ1=PSJS
+4 IF $DATA(ZPSJS)
SET PSSTSVZ2=ZPSJS
+5 IF $DATA(XPSJS)
SET PSSTSVX2=XPSJS
+6 QUIT
+7 ;
TEMSFRX ;Template restores called from the PSSJ SCHEDULE EDIT template
+1 KILL X,Y,PSJS,ZPSJS,XPSJS
+2 IF $DATA(PSSTSVX1)
SET X=PSSTSVX1
+3 IF $DATA(PSSTSVY1)
SET Y=PSSTSVY1
+4 IF $DATA(PSSTSVZ1)
SET PSJS=PSSTSVZ1
+5 IF $DATA(PSSTSVZ2)
SET ZPSJS=PSSTSVZ2
+6 IF $DATA(PSSTSVX2)
SET XPSJS=PSSTSVX2
+7 QUIT
