- 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 Apr 23, 2025@18:21:03 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
