ECXDIVIV ;BIR/CML-Enter/Edit and Print IV Room Division ;2/7/14 16:32
;;3.0;DSS EXTRACTS;**8,105,149**;Dec 22, 1997;Build 27
;
ED ;enter/edit division field for iv rooms
N CHKFLG,DIC,DIE,DA,DR
W !!,"This option allows editing of the DIVISION field for IV Rooms.",!
S CHKFLG=0,OUT=0
D CHK Q:CHKFLG
F D Q:OUT
.W ! S DIC=59.5,DIC(0)="QEAMZ" D ^DIC
.I Y<0 S OUT=1 Q
.I $G(^PS(59.5,+Y,"I"))]"" W " *INACTIVE*",$C(7)
.S DIE=DIC,DA=+Y
.S DR=.02 D ^DIE K DA
Q
;
PRT ;print worksheet
N ECXPORT,CNT ;149
W !!,"This option will produce a worksheet listing all entries in the IV Room file"
W !,"(#59.5). It should be used to help DSS and Pharmacy services define and"
W !,"review the DIVISION assignments for each IV Room.",!! S QFLG=0
S QFLG=0,CHKFLG=0
D CHK Q:CHKFLG
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I ECXPORT D Q ;Section added in 149
.K ^TMP($J,"ECXPORT")
.S ^TMP($J,"ECXPORT",0)="IV ROOM^DIVISION^INACTIVE DATE",CNT=1
.D START
.D EXPDISP^ECXUTL1
D EN^XUTMDEVQ("START^ECXDIVIV","DSS - IV Room List")
I POP D
.W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
.D PAUSE
K ^TMP($J,"ECXDSS")
Q
;
START ;queued entry point
N CHKFLG,DIV,DIVNM,INACT,IV,IVRM,JJ,LN1,LN2,PDT,PG,QFLG,SS,X,Y
I '$D(DT) S DT=$$HTFM^XLFDT(+$H)
K ^TMP("ECXDIVIV",$J),^TMP($J,"ECXDSS") S QFLG=0,IV=0
;call pharmacy encapsulation api and return all iv rooms information
D ALL^PSJ59P5(,"??","ECXDSS")
F S IV=$O(^TMP($J,"ECXDSS",IV)) Q:'IV D
.S IVRM=$G(^TMP($J,"ECXDSS",IV,.01)),DIV=$P($G(^(.02)),U)
.S DIVNM=$S(DIV="":"ZZZ",1:$E($P(^DG(40.8,DIV,0),U),1,30))
.K INACT I $P($G(^TMP($J,"ECXDSS",IV,19)),U)]"" S INACT=$P(^(19),U,2)
.S ^TMP("ECXDIVIV",$J,DIVNM,IVRM)=$S($D(INACT):INACT,1:"")
;print report
S PG=0,PDT=$$FMTE^XLFDT(DT),$P(LN1,"-",81)="",$P(LN2,"_",30)=""
I '$G(ECXPORT) D HDR ;149
I '$D(^TMP("ECXDIVIV",$J)) I '$G(ECXPORT) W !!,"No Data found for this worksheet."
I $D(^TMP("ECXDIVIV",$J)) S DIVNM="" D
.F S DIVNM=$O(^TMP("ECXDIVIV",$J,DIVNM)) Q:DIVNM="" Q:QFLG D
..S IVRM=""
..F S IVRM=$O(^TMP("ECXDIVIV",$J,DIVNM,IVRM)) Q:IVRM="" Q:QFLG D
...S INACT=^TMP("ECXDIVIV",$J,DIVNM,IVRM)
...I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=IVRM_"^"_DIVNM_"^"_INACT,CNT=CNT+1 Q ;149
...D:$Y+4>IOSL HDR Q:QFLG
...W !!,IVRM,?34,$S(DIVNM="ZZZ":LN2,1:DIVNM),?60,INACT
I $G(ECXPORT) K ^TMP("ECXDIVIV",$J) Q ;149
I $E(IOST)="C"&('QFLG) D PAUSE
K ^TMP("ECXDIVIV",$J) S:$D(ZTQUEUED) ZTREQ="@"
W:$E(IOST)'="C" @IOF
D ^%ZISC
Q
;
HDR ;header
I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1
Q:QFLG
S PG=PG+1 W:$Y!($E(IOST)="C") @IOF
W !,"IV Room Worksheet",?72,"Page: ",PG,!,"Printed ",PDT
W !!,"IV ROOM",?34,"DIVISION",?60,"INACTIVE DATE",!,LN1
Q
;
CHK ;check for existence of necessary files for division functionality
S CHKFLG=0
D ALL^PSJ59P5(,"??","ECXIV")
I '$O(^TMP($J,"ECXIV",0)) D I CHKFLG D EXIT Q
.W !,"The IV Room file (#59.5) does not exist!"
.S CHKFLG=1 D PAUSE
I '$D(^ECX(728.113,0)) D I CHKFLG D EXIT Q
.W $C(7),!!,"Your facility appears to be running a version of Inpatient Medications prior to"
.W !,"version 4.5 which is necessary to use this option."
.S CHKFLG=1 D PAUSE
I '$D(^TMP($J,"ECXIV",$O(^TMP($J,"ECXIV",0)),.02)) D
.W $C(7),!!,"The Inpatient Medications Patch PSJ*4.5*27 has not yet been installed!"
.W !,"It must be loaded before you can proceed with this option."
.S CHKFLG=1 D PAUSE
EXIT K ^TMP($J,"ECXIV")
Q
;
PAUSE ;pause screen
I $E(IOST)="C" D
.S SS=22-$Y F JJ=1:1:SS W !
.S DIR(0)="E" W ! D ^DIR K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXDIVIV 3645 printed Oct 16, 2024@17:53:13 Page 2
ECXDIVIV ;BIR/CML-Enter/Edit and Print IV Room Division ;2/7/14 16:32
+1 ;;3.0;DSS EXTRACTS;**8,105,149**;Dec 22, 1997;Build 27
+2 ;
ED ;enter/edit division field for iv rooms
+1 NEW CHKFLG,DIC,DIE,DA,DR
+2 WRITE !!,"This option allows editing of the DIVISION field for IV Rooms.",!
+3 SET CHKFLG=0
SET OUT=0
+4 DO CHK
if CHKFLG
QUIT
+5 FOR
Begin DoDot:1
+6 WRITE !
SET DIC=59.5
SET DIC(0)="QEAMZ"
DO ^DIC
+7 IF Y<0
SET OUT=1
QUIT
+8 IF $GET(^PS(59.5,+Y,"I"))]""
WRITE " *INACTIVE*",$CHAR(7)
+9 SET DIE=DIC
SET DA=+Y
+10 SET DR=.02
DO ^DIE
KILL DA
End DoDot:1
if OUT
QUIT
+11 QUIT
+12 ;
PRT ;print worksheet
+1 ;149
NEW ECXPORT,CNT
+2 WRITE !!,"This option will produce a worksheet listing all entries in the IV Room file"
+3 WRITE !,"(#59.5). It should be used to help DSS and Pharmacy services define and"
+4 WRITE !,"review the DIVISION assignments for each IV Room.",!!
SET QFLG=0
+5 SET QFLG=0
SET CHKFLG=0
+6 DO CHK
if CHKFLG
QUIT
+7 ;Section added in 149
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF ECXPORT
Begin DoDot:1
+8 KILL ^TMP($JOB,"ECXPORT")
+9 SET ^TMP($JOB,"ECXPORT",0)="IV ROOM^DIVISION^INACTIVE DATE"
SET CNT=1
+10 DO START
+11 DO EXPDISP^ECXUTL1
End DoDot:1
QUIT
+12 DO EN^XUTMDEVQ("START^ECXDIVIV","DSS - IV Room List")
+13 IF POP
Begin DoDot:1
+14 WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
+15 DO PAUSE
End DoDot:1
+16 KILL ^TMP($JOB,"ECXDSS")
+17 QUIT
+18 ;
START ;queued entry point
+1 NEW CHKFLG,DIV,DIVNM,INACT,IV,IVRM,JJ,LN1,LN2,PDT,PG,QFLG,SS,X,Y
+2 IF '$DATA(DT)
SET DT=$$HTFM^XLFDT(+$HOROLOG)
+3 KILL ^TMP("ECXDIVIV",$JOB),^TMP($JOB,"ECXDSS")
SET QFLG=0
SET IV=0
+4 ;call pharmacy encapsulation api and return all iv rooms information
+5 DO ALL^PSJ59P5(,"??","ECXDSS")
+6 FOR
SET IV=$ORDER(^TMP($JOB,"ECXDSS",IV))
if 'IV
QUIT
Begin DoDot:1
+7 SET IVRM=$GET(^TMP($JOB,"ECXDSS",IV,.01))
SET DIV=$PIECE($GET(^(.02)),U)
+8 SET DIVNM=$SELECT(DIV="":"ZZZ",1:$EXTRACT($PIECE(^DG(40.8,DIV,0),U),1,30))
+9 KILL INACT
IF $PIECE($GET(^TMP($JOB,"ECXDSS",IV,19)),U)]""
SET INACT=$PIECE(^(19),U,2)
+10 SET ^TMP("ECXDIVIV",$JOB,DIVNM,IVRM)=$SELECT($DATA(INACT):INACT,1:"")
End DoDot:1
+11 ;print report
+12 SET PG=0
SET PDT=$$FMTE^XLFDT(DT)
SET $PIECE(LN1,"-",81)=""
SET $PIECE(LN2,"_",30)=""
+13 ;149
IF '$GET(ECXPORT)
DO HDR
+14 IF '$DATA(^TMP("ECXDIVIV",$JOB))
IF '$GET(ECXPORT)
WRITE !!,"No Data found for this worksheet."
+15 IF $DATA(^TMP("ECXDIVIV",$JOB))
SET DIVNM=""
Begin DoDot:1
+16 FOR
SET DIVNM=$ORDER(^TMP("ECXDIVIV",$JOB,DIVNM))
if DIVNM=""
QUIT
if QFLG
QUIT
Begin DoDot:2
+17 SET IVRM=""
+18 FOR
SET IVRM=$ORDER(^TMP("ECXDIVIV",$JOB,DIVNM,IVRM))
if IVRM=""
QUIT
if QFLG
QUIT
Begin DoDot:3
+19 SET INACT=^TMP("ECXDIVIV",$JOB,DIVNM,IVRM)
+20 ;149
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",CNT)=IVRM_"^"_DIVNM_"^"_INACT
SET CNT=CNT+1
QUIT
+21 if $Y+4>IOSL
DO HDR
if QFLG
QUIT
+22 WRITE !!,IVRM,?34,$SELECT(DIVNM="ZZZ":LN2,1:DIVNM),?60,INACT
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;149
IF $GET(ECXPORT)
KILL ^TMP("ECXDIVIV",$JOB)
QUIT
+24 IF $EXTRACT(IOST)="C"&('QFLG)
DO PAUSE
+25 KILL ^TMP("ECXDIVIV",$JOB)
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+26 if $EXTRACT(IOST)'="C"
WRITE @IOF
+27 DO ^%ZISC
+28 QUIT
+29 ;
HDR ;header
+1 IF $EXTRACT(IOST)="C"
SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+2 IF $EXTRACT(IOST)="C"
IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
+3 if QFLG
QUIT
+4 SET PG=PG+1
if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
+5 WRITE !,"IV Room Worksheet",?72,"Page: ",PG,!,"Printed ",PDT
+6 WRITE !!,"IV ROOM",?34,"DIVISION",?60,"INACTIVE DATE",!,LN1
+7 QUIT
+8 ;
CHK ;check for existence of necessary files for division functionality
+1 SET CHKFLG=0
+2 DO ALL^PSJ59P5(,"??","ECXIV")
+3 IF '$ORDER(^TMP($JOB,"ECXIV",0))
Begin DoDot:1
+4 WRITE !,"The IV Room file (#59.5) does not exist!"
+5 SET CHKFLG=1
DO PAUSE
End DoDot:1
IF CHKFLG
DO EXIT
QUIT
+6 IF '$DATA(^ECX(728.113,0))
Begin DoDot:1
+7 WRITE $CHAR(7),!!,"Your facility appears to be running a version of Inpatient Medications prior to"
+8 WRITE !,"version 4.5 which is necessary to use this option."
+9 SET CHKFLG=1
DO PAUSE
End DoDot:1
IF CHKFLG
DO EXIT
QUIT
+10 IF '$DATA(^TMP($JOB,"ECXIV",$ORDER(^TMP($JOB,"ECXIV",0)),.02))
Begin DoDot:1
+11 WRITE $CHAR(7),!!,"The Inpatient Medications Patch PSJ*4.5*27 has not yet been installed!"
+12 WRITE !,"It must be loaded before you can proceed with this option."
+13 SET CHKFLG=1
DO PAUSE
End DoDot:1
EXIT KILL ^TMP($JOB,"ECXIV")
+1 QUIT
+2 ;
PAUSE ;pause screen
+1 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+2 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+3 SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+4 QUIT
