ORKPS.m

ORKPS ; slc/CLA - Order checking support procedures for medications ;08-Apr-2013 14:54;DU

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,141,190,232,1010**;Dec 17, 1997;Build 47

 ;Modified - IHS/MSC/MGH - 08/21/2012 - Upper case for take med for order check

 ;Modified - IHS/MSC/MGH - 04/05/2013 - Compound drugs check+10

 Q

CHECK(YY,DFN,MED,OI,ORKDG) ; return drug order checks

 ;YY:    returned array of data

 ;DFN:   patient id

 ;MED:   drug ien [file #50]

 ;OI:    orderable item ien [file #101.43

 ;ORKDG: display group (should be PSI, PSIV, PSO or PSH)

 ; returned info: varies for ^TMP($J x-ref - refer to listings below

 N CMP,CMPDR,CDRG,SAVEDFN

 K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")

 N ORDFN S ORDFN=DFN

 ;IHS/MSC/MGH Find compound meds for order checking

 S CMP=$P($G(^PSDRUG(MED,999999935)),U,1)

 I CMP=1 D

 .S CMPDR=0

 .F  S CMPDR=$O(^PSDRUG(MED,999999936,CMPDR)) Q:'+CMPDR  D

 ..S CDRG=$P($G(^PSDRUG(MED,999999936,CMPDR,0)),U,1)

 ..S SAVEDFN=DFN

 ..D EN^PSOORDRG(DFN,CDRG)

 ..D PROCESS^ORKPS1(OI,ORDFN,ORKDG)

 ..S DFN=SAVEDFN

 ..;end IHS mod

 E  D

 .D EN^PSOORDRG(DFN,MED)

 .D PROCESS^ORKPS1(OI,ORDFN,ORKDG)

 K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")

 Q

CHKSESS(YY,DFN,MED,OI,ORKPDATA,ORKDG) ; return drug order checks for session

 N ORKDGI,ORKDRUG,ORKDRUGA,ORKORN,HOR,SEQ,CNT,CNTX,ORKOI

 N ORKFLG,ORSESS,ORPSPKG,ORPSA,ORKDD,ORSNUM,ORNUM,DUPX,DUPORN

 N ORDFN S ORDFN=DFN

 S ORKFLG=0

 S ORNUM=$P(ORKA,"|",5)

 ;

 ;get other session med orders:

 I $D(^TMP("ORKA",$J)) D

 .S CNT=^TMP("ORKA",$J) F CNTX=1:1:CNT D

 ..S ORSESS=$G(^TMP("ORKA",$J,CNTX))

 ..Q:'$L(ORSESS)

 ..S ORPSPKG=$P(ORSESS,"|",2)

 ..Q:'$L(ORPSPKG)

 ..Q:$E(ORPSPKG,1,2)'="PS"

 ..S ORSNUM=$P(ORSESS,"|",5)

 ..S ORKOI=$P(ORSESS,"|")

 ..;quit if same order/oi:

 ..Q:((+$G(ORNUM)=+$G(ORSNUM))&(+$G(OI)=+$G(ORKOI)))

 ..S:ORPSPKG="PSJ" ORPSPKG="PSI"

 ..S ORKDRUG=$P($P(ORSESS,"|",3),U,4)

 ..;

 ..;if no disp drug selected get disp drug(s) from OI:

 ..I +$G(ORKDRUG)<1,$L(ORKOI) D

 ...I "IOH"[$E(ORPSPKG,3) D OI2DD(.ORPSA,ORKOI,$E(ORPSPKG,3)) D

 ....S ORKDD=0 F  S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD  D

 .....S ORKDRUG=+ORKDD

 .....S:+$G(ORKDRUG)>0 ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM

 ...K ORPSA  ;need to clean out between calls to OI2DD

 ..;

 ..Q:+$G(ORKDRUG)<1

 ..;if dispense drug selected add to array:

 ..S ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM

 ;

 ;get unsigned medication orders:

 S HOR=0,SEQ=0

 S HOR=$O(^TMP("ORR",$J,HOR)) I +$G(HOR)>0 D

 .F  S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1  D

 ..S ORKORN=+$P(^TMP("ORR",$J,HOR,SEQ),U),DUPORN=0

 ..Q:+$G(ORKORN)<1

 ..Q:+ORKORN=+ORNUM

 ..Q:$P(^OR(100,+ORKORN,8,$P(^OR(100,+ORKORN,8,0),U,3),0),U,2)="DC"

 ..Q:$P(^ORD(100.01,$P(^OR(100,+ORKORN,3),U,3),0),U)="DISCONTINUED"

 ..S ORKDRUG=$$VALUE^ORCSAVE2(+ORKORN,"DRUG") ;get disp drug for order

 ..;only process vs. unsigned med order if disp drug is assoc w/order:

 ..Q:+$G(ORKDRUG)<1

 ..S ORPSPKG=$$DGRX^ORQOR2(+ORKORN)

 ..S ORPSPKG=$S(ORPSPKG="UNIT DOSE MEDICATIONS":"PSI",ORPSPKG="OUTPATIENT MEDICATIONS":"PSO",ORPSPKG="IV MEDICATIONS":"PSIV",ORPSPKG="NON-VA MEDICATIONS":"PSH",1:"")

 ..S DUPX="" F  S DUPX=$O(ORKDRUGA(DUPX)) Q:'DUPX!(DUPORN=1)  D

 ...S:ORKORN=ORKDRUGA(DUPX) DUPORN=1

 ..Q:DUPORN=1  ;quit if already processed drug order

 ..S ORKDRUGA(+ORKDRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN

 ;

 K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")

 I $D(ORKDRUGA) D DRGCHK^PSOORDRG(DFN,MED,.ORKDRUGA)

 ;I '$D(ORKDRUGA) D EN^PSOORDRG(DFN,MED)

 D PROCESS^ORKPS1(OI,ORDFN,ORKDG)

 K ^TMP($J,"DI"),^TMP($J,"DD"),^TMP($J,"DC")

 Q

TAKEMED(ORKDFN,ORKMED) ;extrinsic function returns med orderable item if any

 ;active med patient is taking contains any piece of ORKMED

 ;ORKDFN   patient DFN

 ;ORKMED   meds to check vs. active med list in format MED1^MED2^MED3...

 Q:'$L($G(ORKDFN)) "0^Patient not identified."

 Q:'$L($G(ORKMED)) "0^Medication not identified."

 N ORKARX,ORKY,ORI,ORJ,ORCNT,ORKMEDP,ORKRSLT

 D LIST^ORQQPS(.ORKY,ORKDFN,"","")

 Q:$P(ORKY(1),U)="" "0^No active meds found."

 S ORKRSLT="0^No matching meds found."

 S ORCNT=$L(ORKMED,U)

 S ORI=0 F  S ORI=$O(ORKY(ORI)) Q:ORI<1  D

 .S ORKARX=$P(ORKY(ORI),U,2)

 .;IHS/MSC/MGH Make it uppercase

 .S ORKARX=$$UP^XLFSTR(ORKARX)

 .F ORJ=1:1:ORCNT S ORKMEDP=$P(ORKMED,U,ORJ) D

 ..I $L(ORKMEDP),(ORKARX[ORKMEDP) S ORKRSLT="1^"_ORKARX

 Q ORKRSLT

SOLUT(OI) ;extrinsic function returns 1 (true) if the orderable item is

 ; a solution (IV Base)

 Q:+$G(OI)<1 ""

 N OITEXT

 S OITEXT=$G(^ORD(101.43,OI,0))

 Q:'$L(OITEXT) ""

 S OITEXT=$P(OITEXT,U)

 Q:$D(^ORD(101.43,"S.IVB RX",OITEXT)) 1

 Q ""

POLYRX(DFN) ;extrins funct rtns 1 if patient exceeds polypharmacy, 0 if not

 N ORSLT,ORENT,ORLOC,ORPAR,ORMEDS

 S ORSLT=0

 Q:'$L(DFN) ORSLT

 S VA200="" D OERR^VADPT

 S ORLOC=+$G(^DIC(42,+VAIN(4),44))

 K VA200,VAIN

 S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"

 S ORPAR=$$GET^XPAR(ORENT,"ORK POLYPHARMACY",1,"I")

 S ORMEDS=$$NUMRX(DFN)

 I $G(ORMEDS)>$G(ORPAR) S ORSLT=1

 Q ORSLT

GLCREAT(DFN) ;extrinsic function returns patient's (DFN) most recent serum

 ; creatinine within # of days from parameter ORK GLUCOPHAGE CREATININE

 ; results format: test id^result units flag ref range collect d/t^result

 ; used by order check GLUCOPHAGE-LAB RESULTS

 N ORLOC,ORPAR,ORDAYS

 N BDT,CDT,ORY,ORX,ORZ,TEST,ORI,ORJ,CREARSLT,LABFILE,SPECFILE,SPECIMEN

 Q:'$L(DFN) "0^"

 S ORDAYS=$$GCDAYS(DFN)

 Q:'$L(ORDAYS) "0^"

 D NOW^%DTC

 S BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")

 K %

 Q:'$L($G(BDT)) "0^"

 S LABFILE=$$TERMLKUP^ORB31(.ORY,"SERUM CREATININE")

 Q:'$D(ORY) "0^" ;no link between SERUM CREATININE and local lab test

 Q:$G(LABFILE)'=60 "0^"

 S SPECFILE=$$TERMLKUP^ORB31(.ORX,"SERUM SPECIMEN")

 Q:'$D(ORX) "0^" ;no link between SERUM SPECIMEN and local specimen

 Q:$G(SPECFILE)'=61 "0^"

 F ORI=1:1:ORY I +$G(CREARSLT)<1 D

 .S TEST=$P(ORY(ORI),U)

 .Q:+$G(TEST)<1

 .F ORJ=1:1:ORX I +$G(CREARSLT)<1 D

 ..S SPECIMEN=$P(ORX(ORJ),U)

 ..Q:+$G(SPECIMEN)<1

 ..S ORZ=$$LOCL^ORQQLR1(DFN,TEST,SPECIMEN)

 ..Q:'$L($G(ORZ))

 ..S CDT=$P(ORZ,U,7)

 ..I CDT'<BDT S CREARSLT=1

 Q:+$G(CREARSLT)<1 "0^"

 Q $P(ORZ,U)_U_$P(ORZ,U,3)_" "_$P(ORZ,U,4)_" "_$P(ORZ,U,5)_" ("_$P(ORZ,U,6)_")  "_$$FMTE^XLFDT(CDT,"2P")_U_$P(ORZ,U,3)

GCDAYS(DFN) ;extrinsic function to return number of days to look for

 ; glucophage serum creatinine result

 Q:'$L(DFN) ""

 N ORLOC,ORENT,ORDAYS

 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be

 ;reliably determined, and many simultaneous outpt locations can occur):

 S VA200="" D OERR^VADPT

 S ORLOC=+$G(^DIC(42,+VAIN(4),44))

 K VA200,VAIN

 S ORENT=+$G(ORLOC)_";SC(^DIV^SYS^PKG"

 S ORDAYS=$$GET^XPAR(ORENT,"ORK GLUCOPHAGE CREATININE",1,"I")

 Q:$L(ORDAYS) ORDAYS

 Q ""

SUPPLY(OI) ;extrinsic function returns 1 (true) if the orderable item is

 ; a supply

 Q:+$G(OI)<1 ""

 N OITEXT

 S OITEXT=$G(^ORD(101.43,OI,0))

 Q:'$L(OITEXT) ""

 S OITEXT=$P(OITEXT,U)

 Q:$D(^ORD(101.43,"S.SPLY",OITEXT)) 1

 Q ""

NUMRX(DFN) ;extrinsic funct returns number of active meds patient is taking

 N NUMRX,ORPTYPE,ORX,ORY,ORS,ORNUM,ORPRENEW

 S NUMRX=0

 Q:+$G(DFN)<1 NUMRX

 ;

 ;check to determine if inpatient or outpatient:

 D ADM^VADPT2

 S ORPTYPE=$S(+$G(VADMVT)>0:"I",1:"O")

 ;

 K ^TMP("PS",$J)

 D OCL^PSOORRL(DFN,"","")  ;if no date range, returns active meds for pt

 N X

 S X=0

 F  S X=$O(^TMP("PS",$J,X)) Q:X<1  D

 .S ORX=$G(^TMP("PS",$J,X,0))

 .S ORY=$P(ORX,U)

 .S ORNUM=$P(ORX,U,8) ;order entry order number

 .S ORS=$P(ORX,U,9) ;medication status from pharmacy

 .S ORPRENEW=$P(ORX,U,14)  ;pending renewal flag (1: pending renewal)

 .Q:+ORX<1

 .Q:$P(ORY,";",2)'=ORPTYPE  ;quit if med is not pt type (inpt/outpt)

 .;quit if status is a non-active type:

 .Q:$G(ORS)="EXPIRED"

 .Q:$G(ORS)["DISCONTINUE"

 .Q:$G(ORS)="DELETED"

 .Q:+$G(ORPRENEW)>0

 .Q:$$SUPPLY($$OI^ORQOR2(ORNUM))=1  ;quit if a supply

 .S NUMRX=NUMRX+1

 K ^TMP("PS",$J)

 Q NUMRX

OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI

 N PSOI

 Q:'$D(^ORD(101.43,OROI,0))

 S PSOI=$P($P(^ORD(101.43,OROI,0),U,2),";")

 Q:+$G(PSOI)<1

 S:ORPSPKG="H" ORPSPKG="X"  ;if non-va med need to pass api "X"

 D DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)

 Q

ORKPS     ; slc/CLA - Order checking support procedures for medications ;08-Apr-2013 14:54;DU

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,141,190,232,1010**;Dec 17, 1997;Build 47

 +2       ;Modified - IHS/MSC/MGH - 08/21/2012 - Upper case for take med for order check

 +3       ;Modified - IHS/MSC/MGH - 04/05/2013 - Compound drugs check+10

 +4        QUIT 

CHECK(YY,DFN,MED,OI,ORKDG) ; return drug order checks

 +1       ;YY:    returned array of data

 +2       ;DFN:   patient id

 +3       ;MED:   drug ien [file #50]

 +4       ;OI:    orderable item ien [file #101.43

 +5       ;ORKDG: display group (should be PSI, PSIV, PSO or PSH)

 +6       ; returned info: varies for ^TMP($J x-ref - refer to listings below

 +7        NEW CMP,CMPDR,CDRG,SAVEDFN

 +8        KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")

 +9        NEW ORDFN

           SET ORDFN=DFN

 +10      ;IHS/MSC/MGH Find compound meds for order checking

 +11       SET CMP=$PIECE($GET(^PSDRUG(MED,999999935)),U,1)

 +12       IF CMP=1

               Begin DoDot:1

 +13               SET CMPDR=0

 +14               FOR 

                       SET CMPDR=$ORDER(^PSDRUG(MED,999999936,CMPDR))

                       IF '+CMPDR

                           QUIT 

                       Begin DoDot:2

 +15                       SET CDRG=$PIECE($GET(^PSDRUG(MED,999999936,CMPDR,0)),U,1)

 +16                       SET SAVEDFN=DFN

 +17                       DO EN^PSOORDRG(DFN,CDRG)

 +18                       DO PROCESS^ORKPS1(OI,ORDFN,ORKDG)

 +19                       SET DFN=SAVEDFN

 +20      ;end IHS mod

                       End DoDot:2

               End DoDot:1

 +21      IF '$TEST

               Begin DoDot:1

 +22               DO EN^PSOORDRG(DFN,MED)

 +23               DO PROCESS^ORKPS1(OI,ORDFN,ORKDG)

               End DoDot:1

 +24       KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")

 +25       QUIT 

CHKSESS(YY,DFN,MED,OI,ORKPDATA,ORKDG) ; return drug order checks for session

 +1        NEW ORKDGI,ORKDRUG,ORKDRUGA,ORKORN,HOR,SEQ,CNT,CNTX,ORKOI

 +2        NEW ORKFLG,ORSESS,ORPSPKG,ORPSA,ORKDD,ORSNUM,ORNUM,DUPX,DUPORN

 +3        NEW ORDFN

           SET ORDFN=DFN

 +4        SET ORKFLG=0

 +5        SET ORNUM=$PIECE(ORKA,"|",5)

 +6       ;

 +7       ;get other session med orders:

 +8        IF $DATA(^TMP("ORKA",$JOB))

               Begin DoDot:1

 +9                SET CNT=^TMP("ORKA",$JOB)

                   FOR CNTX=1:1:CNT

                       Begin DoDot:2

 +10                       SET ORSESS=$GET(^TMP("ORKA",$JOB,CNTX))

 +11                       IF '$LENGTH(ORSESS)

                               QUIT 

 +12                       SET ORPSPKG=$PIECE(ORSESS,"|",2)

 +13                       IF '$LENGTH(ORPSPKG)

                               QUIT 

 +14                       IF $EXTRACT(ORPSPKG,1,2)'="PS"

                               QUIT 

 +15                       SET ORSNUM=$PIECE(ORSESS,"|",5)

 +16                       SET ORKOI=$PIECE(ORSESS,"|")

 +17      ;quit if same order/oi:

 +18                       IF ((+$GET(ORNUM)=+$GET(ORSNUM))&(+$GET(OI)=+$GET(ORKOI)))

                               QUIT 

 +19                       IF ORPSPKG="PSJ"

                               SET ORPSPKG="PSI"

 +20                       SET ORKDRUG=$PIECE($PIECE(ORSESS,"|",3),U,4)

 +21      ;

 +22      ;if no disp drug selected get disp drug(s) from OI:

 +23                       IF +$GET(ORKDRUG)<1

                               IF $LENGTH(ORKOI)

                                   Begin DoDot:3

 +24                                   IF "IOH"[$EXTRACT(ORPSPKG,3)

                                           DO OI2DD(.ORPSA,ORKOI,$EXTRACT(ORPSPKG,3))

                                           Begin DoDot:4

 +25                                           SET ORKDD=0

                                               FOR 

                                                   SET ORKDD=$ORDER(ORPSA(ORKDD))

                                                   IF 'ORKDD

                                                       QUIT 

                                                   Begin DoDot:5

 +26                                                   SET ORKDRUG=+ORKDD

 +27                                                   IF +$GET(ORKDRUG)>0

                                                           SET ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM

                                                   End DoDot:5

                                           End DoDot:4

 +28      ;need to clean out between calls to OI2DD

                                       KILL ORPSA

                                   End DoDot:3

 +29      ;

 +30                       IF +$GET(ORKDRUG)<1

                               QUIT 

 +31      ;if dispense drug selected add to array:

 +32                       SET ORKDRUGA(ORKDRUG_";"_ORPSPKG_";"_ORSNUM)=ORSNUM

                       End DoDot:2

               End DoDot:1

 +33      ;

 +34      ;get unsigned medication orders:

 +35       SET HOR=0

           SET SEQ=0

 +36       SET HOR=$ORDER(^TMP("ORR",$JOB,HOR))

           IF +$GET(HOR)>0

               Begin DoDot:1

 +37               FOR 

                       SET SEQ=$ORDER(^TMP("ORR",$JOB,HOR,SEQ))

                       IF +SEQ<1

                           QUIT 

                       Begin DoDot:2

 +38                       SET ORKORN=+$PIECE(^TMP("ORR",$JOB,HOR,SEQ),U)

                           SET DUPORN=0

 +39                       IF +$GET(ORKORN)<1

                               QUIT 

 +40                       IF +ORKORN=+ORNUM

                               QUIT 

 +41                       IF $PIECE(^OR(100,+ORKORN,8,$PIECE(^OR(100,+ORKORN,8,0),U,3),0),U,2)="DC"

                               QUIT 

 +42                       IF $PIECE(^ORD(100.01,$PIECE(^OR(100,+ORKORN,3),U,3),0),U)="DISCONTINUED"

                               QUIT 

 +43      ;get disp drug for order

                           SET ORKDRUG=$$VALUE^ORCSAVE2(+ORKORN,"DRUG")

 +44      ;only process vs. unsigned med order if disp drug is assoc w/order:

 +45                       IF +$GET(ORKDRUG)<1

                               QUIT 

 +46                       SET ORPSPKG=$$DGRX^ORQOR2(+ORKORN)

 +47                       SET ORPSPKG=$SELECT(ORPSPKG="UNIT DOSE MEDICATIONS":"PSI",ORPSPKG="OUTPATIENT MEDICATIONS":"PSO",ORPSPKG="IV MEDICATIONS":"PSIV",ORPSPKG="NON-VA MEDICATIONS":"PSH",1:"")

 +48                       SET DUPX=""

                           FOR 

                               SET DUPX=$ORDER(ORKDRUGA(DUPX))

                               IF 'DUPX!(DUPORN=1)

                                   QUIT 

                               Begin DoDot:3

 +49                               IF ORKORN=ORKDRUGA(DUPX)

                                       SET DUPORN=1

                               End DoDot:3

 +50      ;quit if already processed drug order

                           IF DUPORN=1

                               QUIT 

 +51                       SET ORKDRUGA(+ORKDRUG_";"_ORPSPKG_";"_ORKORN)=ORKORN

                       End DoDot:2

               End DoDot:1

 +52      ;

 +53       KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")

 +54       IF $DATA(ORKDRUGA)

               DO DRGCHK^PSOORDRG(DFN,MED,.ORKDRUGA)

 +55      ;I '$D(ORKDRUGA) D EN^PSOORDRG(DFN,MED)

 +56       DO PROCESS^ORKPS1(OI,ORDFN,ORKDG)

 +57       KILL ^TMP($JOB,"DI"),^TMP($JOB,"DD"),^TMP($JOB,"DC")

 +58       QUIT 

TAKEMED(ORKDFN,ORKMED) ;extrinsic function returns med orderable item if any

 +1       ;active med patient is taking contains any piece of ORKMED

 +2       ;ORKDFN   patient DFN

 +3       ;ORKMED   meds to check vs. active med list in format MED1^MED2^MED3...

 +4        IF '$LENGTH($GET(ORKDFN))

               QUIT "0^Patient not identified."

 +5        IF '$LENGTH($GET(ORKMED))

               QUIT "0^Medication not identified."

 +6        NEW ORKARX,ORKY,ORI,ORJ,ORCNT,ORKMEDP,ORKRSLT

 +7        DO LIST^ORQQPS(.ORKY,ORKDFN,"","")

 +8        IF $PIECE(ORKY(1),U)=""

               QUIT "0^No active meds found."

 +9        SET ORKRSLT="0^No matching meds found."

 +10       SET ORCNT=$LENGTH(ORKMED,U)

 +11       SET ORI=0

           FOR 

               SET ORI=$ORDER(ORKY(ORI))

               IF ORI<1

                   QUIT 

               Begin DoDot:1

 +12               SET ORKARX=$PIECE(ORKY(ORI),U,2)

 +13      ;IHS/MSC/MGH Make it uppercase

 +14               SET ORKARX=$$UP^XLFSTR(ORKARX)

 +15               FOR ORJ=1:1:ORCNT

                       SET ORKMEDP=$PIECE(ORKMED,U,ORJ)

                       Begin DoDot:2

 +16                       IF $LENGTH(ORKMEDP)

                               IF (ORKARX[ORKMEDP)

                                   SET ORKRSLT="1^"_ORKARX

                       End DoDot:2

               End DoDot:1

 +17       QUIT ORKRSLT

SOLUT(OI) ;extrinsic function returns 1 (true) if the orderable item is

 +1       ; a solution (IV Base)

 +2        IF +$GET(OI)<1

               QUIT ""

 +3        NEW OITEXT

 +4        SET OITEXT=$GET(^ORD(101.43,OI,0))

 +5        IF '$LENGTH(OITEXT)

               QUIT ""

 +6        SET OITEXT=$PIECE(OITEXT,U)

 +7        IF $DATA(^ORD(101.43,"S.IVB RX",OITEXT))

               QUIT 1

 +8        QUIT ""

POLYRX(DFN) ;extrins funct rtns 1 if patient exceeds polypharmacy, 0 if not

 +1        NEW ORSLT,ORENT,ORLOC,ORPAR,ORMEDS

 +2        SET ORSLT=0

 +3        IF '$LENGTH(DFN)

               QUIT ORSLT

 +4        SET VA200=""

           DO OERR^VADPT

 +5        SET ORLOC=+$GET(^DIC(42,+VAIN(4),44))

 +6        KILL VA200,VAIN

 +7        SET ORENT=+$GET(ORLOC)_";SC(^DIV^SYS^PKG"

 +8        SET ORPAR=$$GET^XPAR(ORENT,"ORK POLYPHARMACY",1,"I")

 +9        SET ORMEDS=$$NUMRX(DFN)

 +10       IF $GET(ORMEDS)>$GET(ORPAR)

               SET ORSLT=1

 +11       QUIT ORSLT

GLCREAT(DFN) ;extrinsic function returns patient's (DFN) most recent serum

 +1       ; creatinine within # of days from parameter ORK GLUCOPHAGE CREATININE

 +2       ; results format: test id^result units flag ref range collect d/t^result

 +3       ; used by order check GLUCOPHAGE-LAB RESULTS

 +4        NEW ORLOC,ORPAR,ORDAYS

 +5        NEW BDT,CDT,ORY,ORX,ORZ,TEST,ORI,ORJ,CREARSLT,LABFILE,SPECFILE,SPECIMEN

 +6        IF '$LENGTH(DFN)

               QUIT "0^"

 +7        SET ORDAYS=$$GCDAYS(DFN)

 +8        IF '$LENGTH(ORDAYS)

               QUIT "0^"

 +9        DO NOW^%DTC

 +10       SET BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")

 +11       KILL %

 +12       IF '$LENGTH($GET(BDT))

               QUIT "0^"

 +13       SET LABFILE=$$TERMLKUP^ORB31(.ORY,"SERUM CREATININE")

 +14      ;no link between SERUM CREATININE and local lab test

           IF '$DATA(ORY)

               QUIT "0^"

 +15       IF $GET(LABFILE)'=60

               QUIT "0^"

 +16       SET SPECFILE=$$TERMLKUP^ORB31(.ORX,"SERUM SPECIMEN")

 +17      ;no link between SERUM SPECIMEN and local specimen

           IF '$DATA(ORX)

               QUIT "0^"

 +18       IF $GET(SPECFILE)'=61

               QUIT "0^"

 +19       FOR ORI=1:1:ORY

               IF +$GET(CREARSLT)<1

                   Begin DoDot:1

 +20                   SET TEST=$PIECE(ORY(ORI),U)

 +21                   IF +$GET(TEST)<1

                           QUIT 

 +22                   FOR ORJ=1:1:ORX

                           IF +$GET(CREARSLT)<1

                               Begin DoDot:2

 +23                               SET SPECIMEN=$PIECE(ORX(ORJ),U)

 +24                               IF +$GET(SPECIMEN)<1

                                       QUIT 

 +25                               SET ORZ=$$LOCL^ORQQLR1(DFN,TEST,SPECIMEN)

 +26                               IF '$LENGTH($GET(ORZ))

                                       QUIT 

 +27                               SET CDT=$PIECE(ORZ,U,7)

 +28                               IF CDT'<BDT

                                       SET CREARSLT=1

                               End DoDot:2

                   End DoDot:1

 +29       IF +$GET(CREARSLT)<1

               QUIT "0^"

 +30       QUIT $PIECE(ORZ,U)_U_$PIECE(ORZ,U,3)_" "_$PIECE(ORZ,U,4)_" "_$PIECE(ORZ,U,5)_" ("_$PIECE(ORZ,U,6)_")  "_$$FMTE^XLFDT(CDT,"2P")_U_$PIECE(ORZ,U,3)

GCDAYS(DFN) ;extrinsic function to return number of days to look for

 +1       ; glucophage serum creatinine result

 +2        IF '$LENGTH(DFN)

               QUIT ""

 +3        NEW ORLOC,ORENT,ORDAYS

 +4       ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be

 +5       ;reliably determined, and many simultaneous outpt locations can occur):

 +6        SET VA200=""

           DO OERR^VADPT

 +7        SET ORLOC=+$GET(^DIC(42,+VAIN(4),44))

 +8        KILL VA200,VAIN

 +9        SET ORENT=+$GET(ORLOC)_";SC(^DIV^SYS^PKG"

 +10       SET ORDAYS=$$GET^XPAR(ORENT,"ORK GLUCOPHAGE CREATININE",1,"I")

 +11       IF $LENGTH(ORDAYS)

               QUIT ORDAYS

 +12       QUIT ""

SUPPLY(OI) ;extrinsic function returns 1 (true) if the orderable item is

 +1       ; a supply

 +2        IF +$GET(OI)<1

               QUIT ""

 +3        NEW OITEXT

 +4        SET OITEXT=$GET(^ORD(101.43,OI,0))

 +5        IF '$LENGTH(OITEXT)

               QUIT ""

 +6        SET OITEXT=$PIECE(OITEXT,U)

 +7        IF $DATA(^ORD(101.43,"S.SPLY",OITEXT))

               QUIT 1

 +8        QUIT ""

NUMRX(DFN) ;extrinsic funct returns number of active meds patient is taking

 +1        NEW NUMRX,ORPTYPE,ORX,ORY,ORS,ORNUM,ORPRENEW

 +2        SET NUMRX=0

 +3        IF +$GET(DFN)<1

               QUIT NUMRX

 +4       ;

 +5       ;check to determine if inpatient or outpatient:

 +6        DO ADM^VADPT2

 +7        SET ORPTYPE=$SELECT(+$GET(VADMVT)>0:"I",1:"O")

 +8       ;

 +9        KILL ^TMP("PS",$JOB)

 +10      ;if no date range, returns active meds for pt

           DO OCL^PSOORRL(DFN,"","")

 +11       NEW X

 +12       SET X=0

 +13       FOR 

               SET X=$ORDER(^TMP("PS",$JOB,X))

               IF X<1

                   QUIT 

               Begin DoDot:1

 +14               SET ORX=$GET(^TMP("PS",$JOB,X,0))

 +15               SET ORY=$PIECE(ORX,U)

 +16      ;order entry order number

                   SET ORNUM=$PIECE(ORX,U,8)

 +17      ;medication status from pharmacy

                   SET ORS=$PIECE(ORX,U,9)

 +18      ;pending renewal flag (1: pending renewal)

                   SET ORPRENEW=$PIECE(ORX,U,14)

 +19               IF +ORX<1

                       QUIT 

 +20      ;quit if med is not pt type (inpt/outpt)

                   IF $PIECE(ORY,";",2)'=ORPTYPE

                       QUIT 

 +21      ;quit if status is a non-active type:

 +22               IF $GET(ORS)="EXPIRED"

                       QUIT 

 +23               IF $GET(ORS)["DISCONTINUE"

                       QUIT 

 +24               IF $GET(ORS)="DELETED"

                       QUIT 

 +25               IF +$GET(ORPRENEW)>0

                       QUIT 

 +26      ;quit if a supply

                   IF $$SUPPLY($$OI^ORQOR2(ORNUM))=1

                       QUIT 

 +27               SET NUMRX=NUMRX+1

               End DoDot:1

 +28       KILL ^TMP("PS",$JOB)

 +29       QUIT NUMRX

OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI

 +1        NEW PSOI

 +2        IF '$DATA(^ORD(101.43,OROI,0))

               QUIT 

 +3        SET PSOI=$PIECE($PIECE(^ORD(101.43,OROI,0),U,2),";")

 +4        IF +$GET(PSOI)<1

               QUIT 

 +5       ;if non-va med need to pass api "X"

           IF ORPSPKG="H"

               SET ORPSPKG="X"

 +6        DO DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)

 +7        QUIT