PSJCROC ;HP/MJE - CLINICAL REMINDER ORDER CHECKS FOR IP OC ;09/22/11 5:00pm
;;5.0;INPATIENT MEDICATIONS;**281,349**;16 DEC 97;Build 4
;
;Reference to ORDERCHK^PXRMORCH supported by DBIA 5531
;Reference to SIG^XUSESIG supported by DBIA 10050
;Reference to ^ORD(101.43 supported by DBIA 5430
;
CK(CDRG1) ;CHECK FOR CROCS AGAINST PROSPECTIVE DRUG
N PSJFIRST
S $P(CROCLN,"=",75)="=",$P(CROCLN2,"-",75)="-"
W "Now processing Clinical Reminder Order Checks. Please wait ..."
D ORDERCHK^PXRMORCH(DFN,-1,0,CDRG1,0)
;H:'$D(^TMP($J,CDRG1)) 2
S (CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG)="" N DIRUT
I $D(^TMP($J,CDRG1)) D
.S CROCHFLG=2,CROCNR=0 ;W CROCLN
.F S CROCSTA=$O(^TMP($J,CDRG1,CROCSTA)) Q:CROCSTA=""!$G(PSGORQF) D
..I CROCSTA=1 S CROCHFLG=1
..F S CROCDNM=$O(^TMP($J,CDRG1,CROCSTA,CROCDNM)) Q:CROCDNM=""!$G(PSGORQF) D
...S CROCSTA2=$S(CROCSTA=1:"HIGH",CROCSTA=2:"MEDIUM",CROCSTA=3:"LOW",1:"UNKNOWN")
...I '$G(PSJFIRST) W !!,CROCLN S PSJFIRST=1
...W !,"*** Clinical Reminder Order Check | Severity: "_CROCSTA2_" ***",!
...W !,CROCDNM,!
...F S CROCNUM=$O(^TMP($J,CDRG1,CROCSTA,CROCDNM,CROCNUM)) Q:CROCNUM=""!$G(PSGORQF) D
....I ($Y+5)>IOSL,$E(IOST)="C" D
.....W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
....;RTC 182375
....;W !,^TMP($J,CDRG1,CROCSTA,CROCDNM,CROCNUM) S PSJCROCF=1
....D LONGTEXT($G(^TMP($J,CDRG1,CROCSTA,CROCDNM,CROCNUM)),79)
....S PSJCROCF=1
...W !!,CROCLN2 I ($Y+5)>IOSL,$E(IOST)="C" W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
K ^TMP($J,CDRG1)
I $G(PSJDGCK) K CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,CDRG1 Q
I CROCHFLG=1 S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue? ",DIR("B")="Y" D ^DIR K DIR
I CROCHFLG=1,Y["^"!(Y=0)!($D(DIRUT)) S (PSGORQF)=1 Q
I CROCHFLG=1 D SIG^XUSESIG I X1="" W !!,"Signature Code not valid" S (PSGORQF)=1 H 2 Q
I CROCHFLG=1 I X1'="" D EN3^PSJRXI("CLINICAL REMINDER",CDRG1)
I CROCHFLG>1 W ! S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="N" D ^DIR K DIR
I CROCHFLG>1,Y=1 D EN3^PSJRXI("CLINICAL REMINDER",CDRG1)
K CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,CDRG1,Y
Q
;
CKIVI ;Log IV interventions
N DIRUT
I $G(PSJDGCK) K CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,CDRG1 Q
I CROCHFLG=1 D
.S CROCIXN1="" F S CROCIXN1=$O(^TMP($J,"CROCDRG",1,CROCIXN1)) Q:CROCIXN1=""!($G(PSGORQF)=1) D
..F CROCIXN2=0:0 S CROCIXN2=$O(^TMP($J,"CROCDRG",1,CROCIXN1,CROCIXN2)) Q:'CROCIXN2!($G(PSGORQF)=1) D
...W ! S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue with "_^TMP($J,"CROCDRG",1,CROCIXN1,CROCIXN2)_"? ",DIR("B")="Y" D ^DIR K DIR
...I Y["^"!(Y=0)!($D(DIRUT)) S PSGORQF=1 Q
...D SIG^XUSESIG I X1="" W !!,"Signature Code not valid" S PSGORQF=1 H 2 Q
...I X1'="" D EN3^PSJRXI("CLINICAL REMINDER",+PSPDRG(1)) ;*349
I CROCHFLG=2!($D(^TMP($J,"CROCDRG",2)))!($D(^TMP($J,"CROCDRG",3))) D
.I $G(PSGORQF)=1 Q
.F CROCIXN1=1:0 S CROCIXN1=$O(^TMP($J,"CROCDRG",CROCIXN1)) Q:'CROCIXN1 D
..S CROCIXN2="" F S CROCIXN2=$O(^TMP($J,"CROCDRG",CROCIXN1,CROCIXN2)) Q:CROCIXN2="" D
...I CROCIXN1=2,$D(^TMP($J,"CROCDRG",1,CROCIXN2)) Q
...I CROCIXN1=3,$D(^TMP($J,"CROCDRG",2,CROCIXN2))!($D(^TMP($J,"CROCDRG",1,CROCIXN2))) Q
...F CROCIXN3=0:0 S CROCIXN3=$O(^TMP($J,"CROCDRG",CROCIXN1,CROCIXN2,CROCIXN3)) Q:'CROCIXN3 D
....S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene with "_^TMP($J,"CROCDRG",CROCIXN1,CROCIXN2,CROCIXN3)_"? ",DIR("B")="N" D ^DIR K DIR
....I Y=1 D EN3^PSJRXI("CLINICAL REMINDER",+PSPDRG(1)) ;*349
K CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,CDRG1,CROCIXN1,CROCIXN2,CROCIXN3,Y,^TMP($J,"CROCDRG")
Q
;
CKIV(CDRG2,IVFLG) ;CHECK FOR CROCS AGAINST PROSPECTIVE IV ORDER
S (CROCSTA2,CROCDNM2,CROCNUM2)="" S CROCCTR=1 N PHROI
I IVFLG="A" S PHROI=$$GET1^DIQ(52.6,CDRG2,15,"I")
I IVFLG="S" S PHROI=$$GET1^DIQ(52.7,CDRG2,9,"I")
S ODRI=$O(^ORD(101.43,"ID",PHROI_";99PSP",0))
D ORDERCHK^PXRMORCH(DFN,ODRI,0,-1,0)
I $D(^TMP($J,$G(ODRI))) D
.S CROCNR=0
.F S CROCSTA2=$O(^TMP($J,ODRI,CROCSTA2)) Q:CROCSTA2="" D
..I IVFLG="A" S ^TMP($J,"CROCDRG",CROCSTA2,$P(TMPDRG1("AD",CRIV),"^",2)_" "_$P(TMPDRG1("AD",CRIV),"^",3),CRIV)=$P(TMPDRG1("AD",CRIV),"^",2)_" "_$P(TMPDRG1("AD",CRIV),"^",3)
..I IVFLG="S" S ^TMP($J,"CROCDRG",CROCSTA2,$P(TMPDRG1("SOL",CRIV),"^",2)_" "_$P(TMPDRG1("SOL",CRIV),"^",3),CRIV)=$P(TMPDRG1("SOL",CRIV),"^",2)_" "_$P(TMPDRG1("SOL",CRIV),"^",3)
..S CROCCTR=CROCCTR+1
..F S CROCDNM2=$O(^TMP($J,ODRI,CROCSTA2,CROCDNM2)) Q:CROCDNM2="" D
...F S CROCNUM2=$O(^TMP($J,ODRI,CROCSTA2,CROCDNM2,CROCNUM2)) Q:CROCNUM2="" D
....S ^TMP($J,"CROCIV",CROCSTA2,CROCDNM2,CROCNUM2)=^TMP($J,ODRI,CROCSTA2,CROCDNM2,CROCNUM2)
K ^TMP($J,$G(ODRI)),CROCCTR,CROCSTA2,CROCDNM2,CROCNUM2,CROCSTR2,CROCHFLG2,ODRI,IVFLG,CDRG2
Q
;
CKIVD ;DISPLAY IV CROCS
S (CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG)="" S CROCNMF=0
N PSJFIRST
I $D(^TMP($J,"CROCIV")) D
.S CROCHFLG=2 ;W !!,CROCLN
.F S CROCSTA=$O(^TMP($J,"CROCIV",CROCSTA)) Q:CROCSTA=""!$G(PSGORQF) D
..I CROCSTA=1 S CROCHFLG=1
..F S CROCDNM=$O(^TMP($J,"CROCIV",CROCSTA,CROCDNM)) Q:CROCDNM=""!$G(PSGORQF) D
...S CROCSTA2=$S(CROCSTA=1:"HIGH",CROCSTA=2:"MEDIUM",CROCSTA=3:"LOW",1:"UNKNOWN")
...I '$G(PSJFIRST) W !!,CROCLN S PSJFIRST=1
...W !,"*** Clinical Reminder Order Check | Severity: "_CROCSTA2_" ***",!
...W !,CROCDNM,! S:'CROCNMF CDRG1=CROCDNM S CROCNMF=1
...F S CROCNUM=$O(^TMP($J,"CROCIV",CROCSTA,CROCDNM,CROCNUM)) Q:CROCNUM=""!$G(PSGORQF) D
....I ($Y+5)>IOSL,$E(IOST)="C" D
.....W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
....;RTC 182375
....;W !,^TMP($J,"CROCIV",CROCSTA,CROCDNM,CROCNUM) S PSJCROCF=1
....D LONGTEXT($G(^TMP($J,"CROCIV",CROCSTA,CROCDNM,CROCNUM)),79)
....S PSJCROCF=1
...W !!,CROCLN2 I ($Y+5)>IOSL,$E(IOST)="C" W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
K ^TMP($J,"CROCIV"),CROCNMF G CKIVI
Q
;
LONGTEXT(PSJTXT,PSJLEN) ;
; The ^DIWP can only handle up to 999 characters. This call is used for long text.
I $G(PSJTXT)="" Q
I '+$G(PSJLEN) S PSJLEN=79
NEW PSJCNT,PSJLINE,PSJOUT,PSJSTR,PSJSTRB,PSJSTRE,PSJSTRL,PSJX
S PSJSTR="",PSJLINE=0,(PSJSTRL,PSJCNT,PSJSTRB,PSJSTRE)=1
;
; If string has no blank space.
I $L(PSJTXT," ")=1,$L(PSJTXT)>PSJLEN D D DSPLTXT(.PSJOUT) Q
. S PSJLINE=$L(PSJTXT)\PSJLEN+$S($L(PSJTXT)#PSJLEN:1,1:0)
. F PSJX=1:1:PSJLINE-1 D
.. S PSJSTR="",PSJSTRE=PSJLEN*PSJX+1
.. S PSJSTR=$E(PSJTXT,PSJSTRB,PSJSTRE),PSJOUT(PSJCNT)=PSJSTR,PSJCNT=PSJCNT+1,PSJSTRB=PSJSTRE+1
. I PSJSTRB,PSJSTRE S PSJOUT(PSJCNT+1)=$E(PSJTXT,PSJSTRB,$L(PSJTXT))
;
; This is for text contains at least a space
F PSJX=1:1:$L(PSJTXT," ") D
. I ($L(PSJSTR)+$L($P(PSJTXT," ",PSJX)))>PSJLEN S PSJSTR="",PSJCNT=PSJCNT+1
. S PSJSTR=PSJSTR_$P(PSJTXT," ",PSJX)_" "
. S PSJOUT(PSJCNT)=PSJSTR
D DSPLTXT(.PSJOUT)
Q
DSPLTXT(PSJOUT) ;
Q:'$D(PSJOUT)
NEW PSJX
F PSJX=0:0 S PSJX=$O(PSJOUT(PSJX)) Q:'PSJX D
. I ($Y+6)>IOSL D PAUSE^PSJLMUT1 W @IOF
. W !,$G(PSJOUT(PSJX))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJCROC 7149 printed Dec 13, 2024@02:06:33 Page 2
PSJCROC ;HP/MJE - CLINICAL REMINDER ORDER CHECKS FOR IP OC ;09/22/11 5:00pm
+1 ;;5.0;INPATIENT MEDICATIONS;**281,349**;16 DEC 97;Build 4
+2 ;
+3 ;Reference to ORDERCHK^PXRMORCH supported by DBIA 5531
+4 ;Reference to SIG^XUSESIG supported by DBIA 10050
+5 ;Reference to ^ORD(101.43 supported by DBIA 5430
+6 ;
CK(CDRG1) ;CHECK FOR CROCS AGAINST PROSPECTIVE DRUG
+1 NEW PSJFIRST
+2 SET $PIECE(CROCLN,"=",75)="="
SET $PIECE(CROCLN2,"-",75)="-"
+3 WRITE "Now processing Clinical Reminder Order Checks. Please wait ..."
+4 DO ORDERCHK^PXRMORCH(DFN,-1,0,CDRG1,0)
+5 ;H:'$D(^TMP($J,CDRG1)) 2
+6 SET (CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG)=""
NEW DIRUT
+7 IF $DATA(^TMP($JOB,CDRG1))
Begin DoDot:1
+8 ;W CROCLN
SET CROCHFLG=2
SET CROCNR=0
+9 FOR
SET CROCSTA=$ORDER(^TMP($JOB,CDRG1,CROCSTA))
if CROCSTA=""!$GET(PSGORQF)
QUIT
Begin DoDot:2
+10 IF CROCSTA=1
SET CROCHFLG=1
+11 FOR
SET CROCDNM=$ORDER(^TMP($JOB,CDRG1,CROCSTA,CROCDNM))
if CROCDNM=""!$GET(PSGORQF)
QUIT
Begin DoDot:3
+12 SET CROCSTA2=$SELECT(CROCSTA=1:"HIGH",CROCSTA=2:"MEDIUM",CROCSTA=3:"LOW",1:"UNKNOWN")
+13 IF '$GET(PSJFIRST)
WRITE !!,CROCLN
SET PSJFIRST=1
+14 WRITE !,"*** Clinical Reminder Order Check | Severity: "_CROCSTA2_" ***",!
+15 WRITE !,CROCDNM,!
+16 FOR
SET CROCNUM=$ORDER(^TMP($JOB,CDRG1,CROCSTA,CROCDNM,CROCNUM))
if CROCNUM=""!$GET(PSGORQF)
QUIT
Begin DoDot:4
+17 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:5
+18 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:5
+19 ;RTC 182375
+20 ;W !,^TMP($J,CDRG1,CROCSTA,CROCDNM,CROCNUM) S PSJCROCF=1
+21 DO LONGTEXT($GET(^TMP($JOB,CDRG1,CROCSTA,CROCDNM,CROCNUM)),79)
+22 SET PSJCROCF=1
End DoDot:4
+23 WRITE !!,CROCLN2
IF ($Y+5)>IOSL
IF $EXTRACT(IOST)="C"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:3
End DoDot:2
End DoDot:1
+24 KILL ^TMP($JOB,CDRG1)
+25 IF $GET(PSJDGCK)
KILL CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,CDRG1
QUIT
+26 IF CROCHFLG=1
SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Continue? "
SET DIR("B")="Y"
DO ^DIR
KILL DIR
+27 IF CROCHFLG=1
IF Y["^"!(Y=0)!($DATA(DIRUT))
SET (PSGORQF)=1
QUIT
+28 IF CROCHFLG=1
DO SIG^XUSESIG
IF X1=""
WRITE !!,"Signature Code not valid"
SET (PSGORQF)=1
HANG 2
QUIT
+29 IF CROCHFLG=1
IF X1'=""
DO EN3^PSJRXI("CLINICAL REMINDER",CDRG1)
+30 IF CROCHFLG>1
WRITE !
SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Intervene? "
SET DIR("B")="N"
DO ^DIR
KILL DIR
+31 IF CROCHFLG>1
IF Y=1
DO EN3^PSJRXI("CLINICAL REMINDER",CDRG1)
+32 KILL CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,CDRG1,Y
+33 QUIT
+34 ;
CKIVI ;Log IV interventions
+1 NEW DIRUT
+2 IF $GET(PSJDGCK)
KILL CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,CDRG1
QUIT
+3 IF CROCHFLG=1
Begin DoDot:1
+4 SET CROCIXN1=""
FOR
SET CROCIXN1=$ORDER(^TMP($JOB,"CROCDRG",1,CROCIXN1))
if CROCIXN1=""!($GET(PSGORQF)=1)
QUIT
Begin DoDot:2
+5 FOR CROCIXN2=0:0
SET CROCIXN2=$ORDER(^TMP($JOB,"CROCDRG",1,CROCIXN1,CROCIXN2))
if 'CROCIXN2!($GET(PSGORQF)=1)
QUIT
Begin DoDot:3
+6 WRITE !
SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Continue with "_^TMP($JOB,"CROCDRG",1,CROCIXN1,CROCIXN2)_"? "
SET DIR("B")="Y"
DO ^DIR
KILL DIR
+7 IF Y["^"!(Y=0)!($DATA(DIRUT))
SET PSGORQF=1
QUIT
+8 DO SIG^XUSESIG
IF X1=""
WRITE !!,"Signature Code not valid"
SET PSGORQF=1
HANG 2
QUIT
+9 ;*349
IF X1'=""
DO EN3^PSJRXI("CLINICAL REMINDER",+PSPDRG(1))
End DoDot:3
End DoDot:2
End DoDot:1
+10 IF CROCHFLG=2!($DATA(^TMP($JOB,"CROCDRG",2)))!($DATA(^TMP($JOB,"CROCDRG",3)))
Begin DoDot:1
+11 IF $GET(PSGORQF)=1
QUIT
+12 FOR CROCIXN1=1:0
SET CROCIXN1=$ORDER(^TMP($JOB,"CROCDRG",CROCIXN1))
if 'CROCIXN1
QUIT
Begin DoDot:2
+13 SET CROCIXN2=""
FOR
SET CROCIXN2=$ORDER(^TMP($JOB,"CROCDRG",CROCIXN1,CROCIXN2))
if CROCIXN2=""
QUIT
Begin DoDot:3
+14 IF CROCIXN1=2
IF $DATA(^TMP($JOB,"CROCDRG",1,CROCIXN2))
QUIT
+15 IF CROCIXN1=3
IF $DATA(^TMP($JOB,"CROCDRG",2,CROCIXN2))!($DATA(^TMP($JOB,"CROCDRG",1,CROCIXN2)))
QUIT
+16 FOR CROCIXN3=0:0
SET CROCIXN3=$ORDER(^TMP($JOB,"CROCDRG",CROCIXN1,CROCIXN2,CROCIXN3))
if 'CROCIXN3
QUIT
Begin DoDot:4
+17 SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Intervene with "_^TMP($JOB,"CROCDRG",CROCIXN1,CROCIXN2,CROCIXN3)_"? "
SET DIR("B")="N"
DO ^DIR
KILL DIR
+18 ;*349
IF Y=1
DO EN3^PSJRXI("CLINICAL REMINDER",+PSPDRG(1))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 KILL CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,CDRG1,CROCIXN1,CROCIXN2,CROCIXN3,Y,^TMP($JOB,"CROCDRG")
+20 QUIT
+21 ;
CKIV(CDRG2,IVFLG) ;CHECK FOR CROCS AGAINST PROSPECTIVE IV ORDER
+1 SET (CROCSTA2,CROCDNM2,CROCNUM2)=""
SET CROCCTR=1
NEW PHROI
+2 IF IVFLG="A"
SET PHROI=$$GET1^DIQ(52.6,CDRG2,15,"I")
+3 IF IVFLG="S"
SET PHROI=$$GET1^DIQ(52.7,CDRG2,9,"I")
+4 SET ODRI=$ORDER(^ORD(101.43,"ID",PHROI_";99PSP",0))
+5 DO ORDERCHK^PXRMORCH(DFN,ODRI,0,-1,0)
+6 IF $DATA(^TMP($JOB,$GET(ODRI)))
Begin DoDot:1
+7 SET CROCNR=0
+8 FOR
SET CROCSTA2=$ORDER(^TMP($JOB,ODRI,CROCSTA2))
if CROCSTA2=""
QUIT
Begin DoDot:2
+9 IF IVFLG="A"
SET ^TMP($JOB,"CROCDRG",CROCSTA2,$PIECE(TMPDRG1("AD",CRIV),"^",2)_" "_$PIECE(TMPDRG1("AD",CRIV),"^",3),CRIV)=$PIECE(TMPDRG1("AD",CRIV),"^",2)_" "_$PIECE(TMPDRG1("AD",CRIV),"^",3)
+10 IF IVFLG="S"
SET ^TMP($JOB,"CROCDRG",CROCSTA2,$PIECE(TMPDRG1("SOL",CRIV),"^",2)_" "_$PIECE(TMPDRG1("SOL",CRIV),"^",3),CRIV)=$PIECE(TMPDRG1("SOL",CRIV),"^",2)_" "_$PIECE(TMPDRG1("SOL",CRIV),"^",3)
+11 SET CROCCTR=CROCCTR+1
+12 FOR
SET CROCDNM2=$ORDER(^TMP($JOB,ODRI,CROCSTA2,CROCDNM2))
if CROCDNM2=""
QUIT
Begin DoDot:3
+13 FOR
SET CROCNUM2=$ORDER(^TMP($JOB,ODRI,CROCSTA2,CROCDNM2,CROCNUM2))
if CROCNUM2=""
QUIT
Begin DoDot:4
+14 SET ^TMP($JOB,"CROCIV",CROCSTA2,CROCDNM2,CROCNUM2)=^TMP($JOB,ODRI,CROCSTA2,CROCDNM2,CROCNUM2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL ^TMP($JOB,$GET(ODRI)),CROCCTR,CROCSTA2,CROCDNM2,CROCNUM2,CROCSTR2,CROCHFLG2,ODRI,IVFLG,CDRG2
+16 QUIT
+17 ;
CKIVD ;DISPLAY IV CROCS
+1 SET (CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG)=""
SET CROCNMF=0
+2 NEW PSJFIRST
+3 IF $DATA(^TMP($JOB,"CROCIV"))
Begin DoDot:1
+4 ;W !!,CROCLN
SET CROCHFLG=2
+5 FOR
SET CROCSTA=$ORDER(^TMP($JOB,"CROCIV",CROCSTA))
if CROCSTA=""!$GET(PSGORQF)
QUIT
Begin DoDot:2
+6 IF CROCSTA=1
SET CROCHFLG=1
+7 FOR
SET CROCDNM=$ORDER(^TMP($JOB,"CROCIV",CROCSTA,CROCDNM))
if CROCDNM=""!$GET(PSGORQF)
QUIT
Begin DoDot:3
+8 SET CROCSTA2=$SELECT(CROCSTA=1:"HIGH",CROCSTA=2:"MEDIUM",CROCSTA=3:"LOW",1:"UNKNOWN")
+9 IF '$GET(PSJFIRST)
WRITE !!,CROCLN
SET PSJFIRST=1
+10 WRITE !,"*** Clinical Reminder Order Check | Severity: "_CROCSTA2_" ***",!
+11 WRITE !,CROCDNM,!
if 'CROCNMF
SET CDRG1=CROCDNM
SET CROCNMF=1
+12 FOR
SET CROCNUM=$ORDER(^TMP($JOB,"CROCIV",CROCSTA,CROCDNM,CROCNUM))
if CROCNUM=""!$GET(PSGORQF)
QUIT
Begin DoDot:4
+13 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:5
+14 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:5
+15 ;RTC 182375
+16 ;W !,^TMP($J,"CROCIV",CROCSTA,CROCDNM,CROCNUM) S PSJCROCF=1
+17 DO LONGTEXT($GET(^TMP($JOB,"CROCIV",CROCSTA,CROCDNM,CROCNUM)),79)
+18 SET PSJCROCF=1
End DoDot:4
+19 WRITE !!,CROCLN2
IF ($Y+5)>IOSL
IF $EXTRACT(IOST)="C"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:3
End DoDot:2
End DoDot:1
+20 KILL ^TMP($JOB,"CROCIV"),CROCNMF
GOTO CKIVI
+21 QUIT
+22 ;
LONGTEXT(PSJTXT,PSJLEN) ;
+1 ; The ^DIWP can only handle up to 999 characters. This call is used for long text.
+2 IF $GET(PSJTXT)=""
QUIT
+3 IF '+$GET(PSJLEN)
SET PSJLEN=79
+4 NEW PSJCNT,PSJLINE,PSJOUT,PSJSTR,PSJSTRB,PSJSTRE,PSJSTRL,PSJX
+5 SET PSJSTR=""
SET PSJLINE=0
SET (PSJSTRL,PSJCNT,PSJSTRB,PSJSTRE)=1
+6 ;
+7 ; If string has no blank space.
+8 IF $LENGTH(PSJTXT," ")=1
IF $LENGTH(PSJTXT)>PSJLEN
Begin DoDot:1
+9 SET PSJLINE=$LENGTH(PSJTXT)\PSJLEN+$SELECT($LENGTH(PSJTXT)#PSJLEN:1,1:0)
+10 FOR PSJX=1:1:PSJLINE-1
Begin DoDot:2
+11 SET PSJSTR=""
SET PSJSTRE=PSJLEN*PSJX+1
+12 SET PSJSTR=$EXTRACT(PSJTXT,PSJSTRB,PSJSTRE)
SET PSJOUT(PSJCNT)=PSJSTR
SET PSJCNT=PSJCNT+1
SET PSJSTRB=PSJSTRE+1
End DoDot:2
+13 IF PSJSTRB
IF PSJSTRE
SET PSJOUT(PSJCNT+1)=$EXTRACT(PSJTXT,PSJSTRB,$LENGTH(PSJTXT))
End DoDot:1
DO DSPLTXT(.PSJOUT)
QUIT
+14 ;
+15 ; This is for text contains at least a space
+16 FOR PSJX=1:1:$LENGTH(PSJTXT," ")
Begin DoDot:1
+17 IF ($LENGTH(PSJSTR)+$LENGTH($PIECE(PSJTXT," ",PSJX)))>PSJLEN
SET PSJSTR=""
SET PSJCNT=PSJCNT+1
+18 SET PSJSTR=PSJSTR_$PIECE(PSJTXT," ",PSJX)_" "
+19 SET PSJOUT(PSJCNT)=PSJSTR
End DoDot:1
+20 DO DSPLTXT(.PSJOUT)
+21 QUIT
DSPLTXT(PSJOUT) ;
+1 if '$DATA(PSJOUT)
QUIT
+2 NEW PSJX
+3 FOR PSJX=0:0
SET PSJX=$ORDER(PSJOUT(PSJX))
if 'PSJX
QUIT
Begin DoDot:1
+4 IF ($Y+6)>IOSL
DO PAUSE^PSJLMUT1
WRITE @IOF
+5 WRITE !,$GET(PSJOUT(PSJX))
End DoDot:1
+6 QUIT
