ORQOREP ;ISP/JMH,RFR - REPORT FOR QUICK ORDERS ;09/05/2014 14:41
;;3.0;ORDER ENTRY/RESULTS REPORTING;**366,350**;Dec 17, 1997;Build 77
Q
DIFF ;
W !!,"This report identifies Medication Quick orders that have a free text dosage",!
W "that does not match exactly one of the Local Dosages from Pharmacy.",!
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,TYPE,SAVE
S DIR(0)="S"_U_"S:System Quick Orders;P:Personal Quick Orders;PS:Personal and System Quick Orders"
S DIR("A")="SELECT THE TYPE OF QUICK ORDER",DIR("B")="PS" D ^DIR
Q:"PS"'[$G(Y)
S TYPE="I $P($G(^ORD(101.41,ORI,0)),U,4)=""Q"""
I Y="P" S TYPE=TYPE_",($E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)=""ORWDQ "")"
I Y="S" S TYPE=TYPE_",($E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)'=""ORWDQ "")"
K DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="S"_U_"L:Local Possible Dosages;P:Possible Dosages;N:No Local Possible and No Possible Dosages"
S DIR("A")="SELECT THE TYPE OF DOSAGE",DIR("B")="L" D ^DIR
Q:"^L^P^N^"'[(U_$G(Y)_U)
S ORY=Y
S SAVE("TYPE")="",SAVE("ORY")=""
D DEVICE^ORUTL("DIFFQ^ORQOREP","OR QUICK ORDER FREE-TEXT","Q",.SAVE)
Q
DIFFQ ;TASKMAN ENTRY POINT
;return list of quick orders in a reminder dialog
K ^TMP($J,"OR REMDLG")
D FQOIRDLG^ORINQIV
N ORI,ORPT,ORCNT,DATA,EXIT,STOP,PGNUM,OUT,DOSAGE
S ORPT=$O(^DPT(0)),ORCNT=0,DATA=$NA(^TMP($J,"ORQOREP")) K @DATA
S OUT(1)="This report identifies medication quick orders that have a free text dosage"
S OUT(2)="that does not exactly match one of the local possible dosages from pharmacy.",OUT=3
I ORY'="N" D
.S DOSAGE="I $L($P(ORDOSE(ORDLI),U))>0,($L($P(ORDOSE(ORDLI),U,3))>0)"
.S OUT(OUT)="When at least one active dispense drug linked to the orderable item has a",OUT=OUT+1
.S OUT(OUT)="possible dosage then only possible dosages will be available in CPRS and",OUT=OUT+1
.S OUT(OUT)="for dose checks for the package (I/O) of the quick order. "
.I ORY="L" D
..S DOSAGE=$TR(DOSAGE,">","=")
..S OUT(OUT)=OUT(OUT)_"Thus, no possible",OUT=OUT+1
..S OUT(OUT)="dosages have been created and only local possible dosages are listed below."
.I ORY="P" D
..S OUT(OUT)=OUT(OUT)_"Thus, local",OUT=OUT+1
..S OUT(OUT)="possible dosages for a dispense drug will not be listed below, only possible",OUT=OUT+1
..S OUT(OUT)="dosages are listed.",OUT=OUT+1
I ORY="N" D
.S OUT(OUT)="It shows when all of the active dispense drugs linked to the orderable",OUT=OUT+1
.S OUT(OUT)="item have NO possible dosages and NO local possible dosages for the",OUT=OUT+1
.S OUT(OUT)="package (I/O) of the quick order."
S ORI=0 F S ORI=$O(^ORD(101.41,ORI)) Q:'ORI D
.X TYPE Q:'$T
.N CONT,USER
.S CONT=$S($O(^ORD(101.41,"AD",ORI,0)):1,$D(^TMP($J,"OR REMDLG",ORI)):1,$D(^ORD(101.44,"C",ORI)):1,1:0)
.Q:'CONT
.;FOR PERSONAL QUICK ORDERS, STOP EXAMINING IF ALL ASSOCIATED USERS ARE INACTIVE
.S EXIT=0
.I $E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)="ORWDQ " D
..N OQVIEN S OQVIEN=0,EXIT=1
..F S OQVIEN=$O(^ORD(101.44,"C",ORI,OQVIEN)) Q:+$G(OQVIEN)=0 D
...S USER=$P($P($G(^ORD(101.44,OQVIEN,0)),U,1)," ",2),USER=$E(USER,4,$L(USER))
...S USER(USER)=+$$ACTIVE^XUSER(USER)
...S:EXIT EXIT='USER(USER)
...I 'USER(USER) K USER(USER)
...I $D(USER(USER)) S USER(USER)=$$GET1^DIQ(200,USER_",",.01)
.Q:+EXIT
.N ORINSDLG,ORINSIEN,ORDRDLG,ORDRIEN,ORINS,ORDR,OROIDLG,OROIIEN,OROI,ORDREXT,ORFLAG,ORDG,ORPTYPE,ORDOSE,ORPSOI
.S OROIDLG=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
.Q:'OROIDLG
.S OROIIEN=$O(^ORD(101.41,ORI,6,"D",OROIDLG,0))
.Q:'OROIIEN
.S OROI=$G(^ORD(101.41,ORI,6,OROIIEN,1))
.Q:'OROI
.Q:$P($P($G(^ORD(101.43,OROI,0)),U,2),";",2)'="99PSP"
.S ORPSOI=$P($P($G(^ORD(101.43,OROI,0)),U,2),";")
.S ORINSDLG=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
.Q:'ORINSDLG
.S ORINSIEN=$O(^ORD(101.41,ORI,6,"D",ORINSDLG,0))
.Q:'ORINSIEN
.S ORINS=$G(^ORD(101.41,ORI,6,ORINSIEN,1))
.Q:$L(ORINS)=0
.;GET DISPLAY GROUP
.S ORDG=$P($G(^ORD(101.41,ORI,0)),U,5)
.S ORDG=$P($G(^ORD(100.98,ORDG,0)),U)
.S ORPTYPE=$S(ORDG="UNIT DOSE MEDICATIONS":"U",ORDG="NON-VA MEDICATIONS":"X",ORDG="IV MEDICATIONS":"I",1:"O")
.N ORDOSE2,ORDISP D ALLDOSES(OROI,ORPTYPE,ORPT,.ORDOSE2,.ORDISP)
.N ORDOSE D DOSE^PSSOPKI1(.ORDOSE,ORPSOI,ORPTYPE)
.I $D(DOSAGE),('$D(ORDOSE(1))) Q
.I '$D(DOSAGE),($D(ORDOSE(1))) Q
.I $D(DOSAGE) D
..N ORDLI S ORDLI=0,EXIT=1
..F S ORDLI=$O(ORDOSE(ORDLI)) Q:'ORDLI!('EXIT) D
...X DOSAGE S EXIT='$T
.Q:+$G(EXIT)
.Q:$D(ORDOSE2(ORINS))
.N OREXMPT,OREI
.S OREXMPT=1,OREI=0 F S OREI=$O(ORDOSE("DD",OREI)) Q:'OREI I '$$EXMT^PSSDSAPI(OREI) S OREXMPT=0
.S:'$D(DOSAGE) OREXMPT=0
.Q:OREXMPT
.N SUBSCRIPT
.S SUBSCRIPT=$S($E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)="ORWDQ ":"PERSONAL",1:"SYSTEM")
.D ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR("QUICK ORDER (IEN):",24," ")_$P(^ORD(101.41,ORI,0),U)_" ("_ORI_")")
.D ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR("QO DISPLAY NAME:",24," ")_$P(^ORD(101.41,ORI,0),U,2))
.I $D(USER)>9 D
..N HEADER S HEADER=" OWNER(S): "
..S USER=0 F S USER=$O(USER(USER)) Q:+$G(USER)=0 D
...D ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR(HEADER,24," ")_USER(USER))
...S:HEADER'=" " HEADER=" "
.D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("DISPLAY GROUP:",22," ")_ORDG)
.D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("ORDERABLE ITEM IEN:",22," ")_OROI)
.D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("ORDERABLE ITEM NAME:",22," ")_$P(^ORD(101.43,OROI,0),U))
.D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("QO INSTRUCTIONS:",22," ")_$E(ORINS,1,50))
.D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("DISPENSE:",22," ")_$P(ORDISP,U,4))
.I $L(ORINS)>50 D ADD(DATA,SUBSCRIPT," "_$$REPEAT^XLFSTR(" ",22)_$E(ORINS,50,$L(ORINS)))
.D ADD(DATA,SUBSCRIPT," CPRS DOSAGE LIST:")
.N ORDI S ORDI="" F S ORDI=$O(ORDOSE2(ORDI)) Q:ORDI="" D ADD(DATA,SUBSCRIPT," "_ORDI)
.D ADD(DATA,SUBSCRIPT,"")
.S ORCNT=ORCNT+1
S STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
Q:STOP
S OUT=0 F S OUT=$O(OUT(OUT)) Q:'OUT W OUT(OUT),!
W !
N COUNT,LINE
F SUBSCRIPT="SYSTEM","PERSONAL" Q:STOP D
.F COUNT=1:1:+$G(@DATA@("COUNT",SUBSCRIPT)) Q:STOP D
..I ($Y+CBUFFER+$O(@DATA@(SUBSCRIPT,COUNT,"?"),-1))>IOSL S STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
..Q:STOP
..S LINE=0 F S LINE=$O(@DATA@(SUBSCRIPT,COUNT,LINE)) Q:+$G(LINE)=0!(STOP) D
...W @DATA@(SUBSCRIPT,COUNT,LINE)
...I ($Y+CBUFFER)<IOSL W !
...I ($Y+CBUFFER)=IOSL S STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
I 'STOP D
.I ($Y+CBUFFER+2)>IOSL S STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
.Q:STOP
.W !,$$CJ^XLFSTR(ORCNT_" Quick Orders Found",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
K ^TMP($J,"OR REMDLG"),@DATA
S:$D(ZTQUEUED) ZTREQ="@"
Q
ADD(ARRAY,SUBSCRIPT,VALUE) ;ADD A LINE TO THE OUTPUT ARRAY
;PARAMETERS: ARRAY => NODE ADDRESS OF ARRAY TO STORE VALUE IN
; SUBSCRIPT => THE SUBSCRIPT DESCENDANT FROM ARRAY IN WHICH TO STORE VALUE IN
; VALUE => DATA TO STORE IN THE OUTPUT ARRAY
I VALUE["QUICK ORDER (IEN):" S @ARRAY@("COUNT",SUBSCRIPT)=1+$G(@ARRAY@("COUNT",SUBSCRIPT))
N LNUM,HOLDING,COLUMN
S COLUMN=$S(VALUE'[":":4,1:24)
D WRAP^ORUTL(VALUE,"HOLDING",1,1,COLUMN)
S LNUM=1+$O(@ARRAY@(SUBSCRIPT,@ARRAY@("COUNT",SUBSCRIPT),"?"),-1)
S HOLDING=0 F S HOLDING=$O(HOLDING(HOLDING)) Q:'HOLDING D
.S @ARRAY@(SUBSCRIPT,@ARRAY@("COUNT",SUBSCRIPT),LNUM)=HOLDING(HOLDING)
.S LNUM=1+LNUM
Q
ALLDOSES(OROI,ORTYPE,ORPT,OROUT,ORDISP) ;return all doses for an orderable item
N ORY
S ORDISP="NA"
D OISLCT^ORWDPS2(.ORY,OROI,ORTYPE,ORPT,"Y","Y")
N I S I=0 F S I=$O(ORY(I)) Q:'I D
.I ORY(I)="~AllDoses" D
..F S I=$O(ORY(I)) Q:'I Q:$E(ORY(I),1,1)="~" D
...S OROUT($E(ORY(I),2,$L($P(ORY(I),U))))=""
.I ORY(I)="~Dispense" D
..F S I=$O(ORY(I)) Q:'I Q:$E(ORY(I),1,1)="~" D
...S ORDISP=ORY(I)
Q
CASE ;
W !!,"This report identifies quick orders that have potentially had the DRUG name",!
W "edited such that when the quick order is loaded in CPRS the dosage that is",!
W "saved with the quick order does not match any of the dosages available for",!
W "selection in the list. This causes the dosage checks not to be able to be",!
W "performed correctly. The edit to the drug that this specifically looks for",!
W "is a case change to the DRUG name. If the name is changed so that it",!
W "contains different characters that are not just case changes, this report",!
W "will not identify them.",!
D DEVICE^ORUTL("CASEQ^ORQOREP","OR QUICK ORDER MIXED-CASE","Q")
Q
CASEQ ;TASKMAN ENTRY POINT
N ORI,ORPT,ORCNT,STOP,PGNUM
S ORPT=$O(^DPT(0)),ORCNT=0
S ORI=0 F S ORI=$O(^ORD(101.41,ORI)) Q:'ORI!($G(STOP)) D
.Q:($P(^ORD(101.41,ORI,0),U,4)'="Q")
.N ORINSDLG,ORINSIEN,ORDRDLG,ORDRIEN,ORINS,ORDR,OROIDLG,OROIIEN,OROI,ORDREXT,ORFLAG,ORDG,ORPTYPE,ORDOSE,ORPSOI
.S OROIDLG=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
.Q:'OROIDLG
.S OROIIEN=$O(^ORD(101.41,ORI,6,"D",OROIDLG,0))
.Q:'OROIIEN
.S OROI=$G(^ORD(101.41,ORI,6,OROIIEN,1))
.Q:'OROI
.Q:$P($P($G(^ORD(101.43,OROI,0)),U,2),";",2)'="99PSP"
.S ORPSOI=$P($P($G(^ORD(101.43,OROI,0)),U,2),";")
.S ORINSDLG=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
.Q:'ORINSDLG
.S ORINSIEN=$O(^ORD(101.41,ORI,6,"D",ORINSDLG,0))
.Q:'ORINSIEN
.S ORINS=$G(^ORD(101.41,ORI,6,ORINSIEN,1))
.Q:$L(ORINS)=0
.S ORDRDLG=$O(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0))
.Q:'ORDRDLG
.S ORDRIEN=$O(^ORD(101.41,ORI,6,"D",ORDRDLG,0))
.Q:'ORDRIEN
.S ORDR=$G(^ORD(101.41,ORI,6,ORDRIEN,1))
.Q:'ORDR
.S ORDREXT=$$EXTVAL^ORWDX2(ORDR,ORDRDLG)
.;GET DISPLAY GROUP
.S ORDG=$P($G(^ORD(101.41,ORI,0)),U,5)
.S ORDG=$P($G(^ORD(100.98,ORDG,0)),U)
.S ORPTYPE=$S(ORDG="UNIT DOSE MEDICATIONS":"I",1:"O")
.I '$L($T(DOSE^PSSOPKI1)) D DOSE^PSSORUTL(.ORDOSE,ORPSOI,ORPTYPE,ORPT)
.I $L($T(DOSE^PSSOPKI1)) D DOSE^PSSOPKI1(.ORDOSE,ORPSOI,ORPTYPE,ORPT)
.N ORFOUND,ORDOSEI S ORDOSEI=0,ORFOUND=0
.F S ORDOSEI=$O(ORDOSE(ORDOSEI)) Q:'ORDOSEI D
..I ORINS[$P(ORDOSE(ORDOSEI),U,5) S ORFOUND=1
.I ORINS[$P($G(ORDOSE("DD",ORDR)),U) Q
.S ORFLAG=""
.Q:ORINS[ORDREXT
.Q:$$UPPER^ORU(ORINS)'[$$UPPER^ORU(ORDREXT)
.I ($Y+CBUFFER+8)>IOSL!($Y=0) S STOP=$$HEADER^ORUTL("QUICK ORDER MIXED-CASE REPORT",.PGNUM)
.Q:$G(STOP)
.W "QUICK ORDER (IEN):",?24,$P(^ORD(101.41,ORI,0),U,2)," (",ORI,")"
.W !,?2,"DISPLAY GROUP: ",?24,ORDG
.W !,?2,"ORDERABLE ITEM IEN:",?24,OROI
.W !,?2,"ORDERABLE ITEM NAME:",?24,$P(^ORD(101.43,OROI,0),U)
.W !,?2,"DRUG IEN:",?24,ORDR
.W !,?2,"DRUG TEXT:",?24,ORDREXT
.W !,?2,"QO INSTRUCTIONS:",?24,ORINS
.I $Y<IOSL W !
.S ORCNT=ORCNT+1
I '$G(STOP) D
.I ($Y+CBUFFER+2)>IOSL!($Y=0) S STOP=$$HEADER^ORUTL("QUICK ORDER MIXED-CASE REPORT",.PGNUM)
.Q:STOP
.W !,$$CJ^XLFSTR(ORCNT_" Quick Orders Found",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQOREP 10744 printed Apr 09, 2024@21:32:42 Page 2
ORQOREP ;ISP/JMH,RFR - REPORT FOR QUICK ORDERS ;09/05/2014 14:41
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**366,350**;Dec 17, 1997;Build 77
+2 QUIT
DIFF ;
+1 WRITE !!,"This report identifies Medication Quick orders that have a free text dosage",!
+2 WRITE "that does not match exactly one of the Local Dosages from Pharmacy.",!
+3 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,TYPE,SAVE
+4 SET DIR(0)="S"_U_"S:System Quick Orders;P:Personal Quick Orders;PS:Personal and System Quick Orders"
+5 SET DIR("A")="SELECT THE TYPE OF QUICK ORDER"
SET DIR("B")="PS"
DO ^DIR
+6 if "PS"'[$GET(Y)
QUIT
+7 SET TYPE="I $P($G(^ORD(101.41,ORI,0)),U,4)=""Q"""
+8 IF Y="P"
SET TYPE=TYPE_",($E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)=""ORWDQ "")"
+9 IF Y="S"
SET TYPE=TYPE_",($E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)'=""ORWDQ "")"
+10 KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+11 SET DIR(0)="S"_U_"L:Local Possible Dosages;P:Possible Dosages;N:No Local Possible and No Possible Dosages"
+12 SET DIR("A")="SELECT THE TYPE OF DOSAGE"
SET DIR("B")="L"
DO ^DIR
+13 if "^L^P^N^"'[(U_$GET(Y)_U)
QUIT
+14 SET ORY=Y
+15 SET SAVE("TYPE")=""
SET SAVE("ORY")=""
+16 DO DEVICE^ORUTL("DIFFQ^ORQOREP","OR QUICK ORDER FREE-TEXT","Q",.SAVE)
+17 QUIT
DIFFQ ;TASKMAN ENTRY POINT
+1 ;return list of quick orders in a reminder dialog
+2 KILL ^TMP($JOB,"OR REMDLG")
+3 DO FQOIRDLG^ORINQIV
+4 NEW ORI,ORPT,ORCNT,DATA,EXIT,STOP,PGNUM,OUT,DOSAGE
+5 SET ORPT=$ORDER(^DPT(0))
SET ORCNT=0
SET DATA=$NAME(^TMP($JOB,"ORQOREP"))
KILL @DATA
+6 SET OUT(1)="This report identifies medication quick orders that have a free text dosage"
+7 SET OUT(2)="that does not exactly match one of the local possible dosages from pharmacy."
SET OUT=3
+8 IF ORY'="N"
Begin DoDot:1
+9 SET DOSAGE="I $L($P(ORDOSE(ORDLI),U))>0,($L($P(ORDOSE(ORDLI),U,3))>0)"
+10 SET OUT(OUT)="When at least one active dispense drug linked to the orderable item has a"
SET OUT=OUT+1
+11 SET OUT(OUT)="possible dosage then only possible dosages will be available in CPRS and"
SET OUT=OUT+1
+12 SET OUT(OUT)="for dose checks for the package (I/O) of the quick order. "
+13 IF ORY="L"
Begin DoDot:2
+14 SET DOSAGE=$TRANSLATE(DOSAGE,">","=")
+15 SET OUT(OUT)=OUT(OUT)_"Thus, no possible"
SET OUT=OUT+1
+16 SET OUT(OUT)="dosages have been created and only local possible dosages are listed below."
End DoDot:2
+17 IF ORY="P"
Begin DoDot:2
+18 SET OUT(OUT)=OUT(OUT)_"Thus, local"
SET OUT=OUT+1
+19 SET OUT(OUT)="possible dosages for a dispense drug will not be listed below, only possible"
SET OUT=OUT+1
+20 SET OUT(OUT)="dosages are listed."
SET OUT=OUT+1
End DoDot:2
End DoDot:1
+21 IF ORY="N"
Begin DoDot:1
+22 SET OUT(OUT)="It shows when all of the active dispense drugs linked to the orderable"
SET OUT=OUT+1
+23 SET OUT(OUT)="item have NO possible dosages and NO local possible dosages for the"
SET OUT=OUT+1
+24 SET OUT(OUT)="package (I/O) of the quick order."
End DoDot:1
+25 SET ORI=0
FOR
SET ORI=$ORDER(^ORD(101.41,ORI))
if 'ORI
QUIT
Begin DoDot:1
+26 XECUTE TYPE
if '$TEST
QUIT
+27 NEW CONT,USER
+28 SET CONT=$SELECT($ORDER(^ORD(101.41,"AD",ORI,0)):1,$DATA(^TMP($JOB,"OR REMDLG",ORI)):1,$DATA(^ORD(101.44,"C",ORI)):1,1:0)
+29 if 'CONT
QUIT
+30 ;FOR PERSONAL QUICK ORDERS, STOP EXAMINING IF ALL ASSOCIATED USERS ARE INACTIVE
+31 SET EXIT=0
+32 IF $EXTRACT($PIECE($GET(^ORD(101.41,ORI,0)),U,1),1,6)="ORWDQ "
Begin DoDot:2
+33 NEW OQVIEN
SET OQVIEN=0
SET EXIT=1
+34 FOR
SET OQVIEN=$ORDER(^ORD(101.44,"C",ORI,OQVIEN))
if +$GET(OQVIEN)=0
QUIT
Begin DoDot:3
+35 SET USER=$PIECE($PIECE($GET(^ORD(101.44,OQVIEN,0)),U,1)," ",2)
SET USER=$EXTRACT(USER,4,$LENGTH(USER))
+36 SET USER(USER)=+$$ACTIVE^XUSER(USER)
+37 if EXIT
SET EXIT='USER(USER)
+38 IF 'USER(USER)
KILL USER(USER)
+39 IF $DATA(USER(USER))
SET USER(USER)=$$GET1^DIQ(200,USER_",",.01)
End DoDot:3
End DoDot:2
+40 if +EXIT
QUIT
+41 NEW ORINSDLG,ORINSIEN,ORDRDLG,ORDRIEN,ORINS,ORDR,OROIDLG,OROIIEN,OROI,ORDREXT,ORFLAG,ORDG,ORPTYPE,ORDOSE,ORPSOI
+42 SET OROIDLG=$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
+43 if 'OROIDLG
QUIT
+44 SET OROIIEN=$ORDER(^ORD(101.41,ORI,6,"D",OROIDLG,0))
+45 if 'OROIIEN
QUIT
+46 SET OROI=$GET(^ORD(101.41,ORI,6,OROIIEN,1))
+47 if 'OROI
QUIT
+48 if $PIECE($PIECE($GET(^ORD(101.43,OROI,0)),U,2),";",2)'="99PSP"
QUIT
+49 SET ORPSOI=$PIECE($PIECE($GET(^ORD(101.43,OROI,0)),U,2),";")
+50 SET ORINSDLG=$ORDER(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
+51 if 'ORINSDLG
QUIT
+52 SET ORINSIEN=$ORDER(^ORD(101.41,ORI,6,"D",ORINSDLG,0))
+53 if 'ORINSIEN
QUIT
+54 SET ORINS=$GET(^ORD(101.41,ORI,6,ORINSIEN,1))
+55 if $LENGTH(ORINS)=0
QUIT
+56 ;GET DISPLAY GROUP
+57 SET ORDG=$PIECE($GET(^ORD(101.41,ORI,0)),U,5)
+58 SET ORDG=$PIECE($GET(^ORD(100.98,ORDG,0)),U)
+59 SET ORPTYPE=$SELECT(ORDG="UNIT DOSE MEDICATIONS":"U",ORDG="NON-VA MEDICATIONS":"X",ORDG="IV MEDICATIONS":"I",1:"O")
+60 NEW ORDOSE2,ORDISP
DO ALLDOSES(OROI,ORPTYPE,ORPT,.ORDOSE2,.ORDISP)
+61 NEW ORDOSE
DO DOSE^PSSOPKI1(.ORDOSE,ORPSOI,ORPTYPE)
+62 IF $DATA(DOSAGE)
IF ('$DATA(ORDOSE(1)))
QUIT
+63 IF '$DATA(DOSAGE)
IF ($DATA(ORDOSE(1)))
QUIT
+64 IF $DATA(DOSAGE)
Begin DoDot:2
+65 NEW ORDLI
SET ORDLI=0
SET EXIT=1
+66 FOR
SET ORDLI=$ORDER(ORDOSE(ORDLI))
if 'ORDLI!('EXIT)
QUIT
Begin DoDot:3
+67 XECUTE DOSAGE
SET EXIT='$TEST
End DoDot:3
End DoDot:2
+68 if +$GET(EXIT)
QUIT
+69 if $DATA(ORDOSE2(ORINS))
QUIT
+70 NEW OREXMPT,OREI
+71 SET OREXMPT=1
SET OREI=0
FOR
SET OREI=$ORDER(ORDOSE("DD",OREI))
if 'OREI
QUIT
IF '$$EXMT^PSSDSAPI(OREI)
SET OREXMPT=0
+72 if '$DATA(DOSAGE)
SET OREXMPT=0
+73 if OREXMPT
QUIT
+74 NEW SUBSCRIPT
+75 SET SUBSCRIPT=$SELECT($EXTRACT($PIECE($GET(^ORD(101.41,ORI,0)),U,1),1,6)="ORWDQ ":"PERSONAL",1:"SYSTEM")
+76 DO ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR("QUICK ORDER (IEN):",24," ")_$PIECE(^ORD(101.41,ORI,0),U)_" ("_ORI_")")
+77 DO ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR("QO DISPLAY NAME:",24," ")_$PIECE(^ORD(101.41,ORI,0),U,2))
+78 IF $DATA(USER)>9
Begin DoDot:2
+79 NEW HEADER
SET HEADER=" OWNER(S): "
+80 SET USER=0
FOR
SET USER=$ORDER(USER(USER))
if +$GET(USER)=0
QUIT
Begin DoDot:3
+81 DO ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR(HEADER,24," ")_USER(USER))
+82 if HEADER'=" "
SET HEADER=" "
End DoDot:3
End DoDot:2
+83 DO ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("DISPLAY GROUP:",22," ")_ORDG)
+84 DO ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("ORDERABLE ITEM IEN:",22," ")_OROI)
+85 DO ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("ORDERABLE ITEM NAME:",22," ")_$PIECE(^ORD(101.43,OROI,0),U))
+86 DO ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("QO INSTRUCTIONS:",22," ")_$EXTRACT(ORINS,1,50))
+87 DO ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("DISPENSE:",22," ")_$PIECE(ORDISP,U,4))
+88 IF $LENGTH(ORINS)>50
DO ADD(DATA,SUBSCRIPT," "_$$REPEAT^XLFSTR(" ",22)_$EXTRACT(ORINS,50,$LENGTH(ORINS)))
+89 DO ADD(DATA,SUBSCRIPT," CPRS DOSAGE LIST:")
+90 NEW ORDI
SET ORDI=""
FOR
SET ORDI=$ORDER(ORDOSE2(ORDI))
if ORDI=""
QUIT
DO ADD(DATA,SUBSCRIPT," "_ORDI)
+91 DO ADD(DATA,SUBSCRIPT,"")
+92 SET ORCNT=ORCNT+1
End DoDot:1
+93 SET STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
+94 if STOP
QUIT
+95 SET OUT=0
FOR
SET OUT=$ORDER(OUT(OUT))
if 'OUT
QUIT
WRITE OUT(OUT),!
+96 WRITE !
+97 NEW COUNT,LINE
+98 FOR SUBSCRIPT="SYSTEM","PERSONAL"
if STOP
QUIT
Begin DoDot:1
+99 FOR COUNT=1:1:+$GET(@DATA@("COUNT",SUBSCRIPT))
if STOP
QUIT
Begin DoDot:2
+100 IF ($Y+CBUFFER+$ORDER(@DATA@(SUBSCRIPT,COUNT,"?"),-1))>IOSL
SET STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
+101 if STOP
QUIT
+102 SET LINE=0
FOR
SET LINE=$ORDER(@DATA@(SUBSCRIPT,COUNT,LINE))
if +$GET(LINE)=0!(STOP)
QUIT
Begin DoDot:3
+103 WRITE @DATA@(SUBSCRIPT,COUNT,LINE)
+104 IF ($Y+CBUFFER)<IOSL
WRITE !
+105 IF ($Y+CBUFFER)=IOSL
SET STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
End DoDot:3
End DoDot:2
End DoDot:1
+106 IF 'STOP
Begin DoDot:1
+107 IF ($Y+CBUFFER+2)>IOSL
SET STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
+108 if STOP
QUIT
+109 WRITE !,$$CJ^XLFSTR(ORCNT_" Quick Orders Found",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," ")
End DoDot:1
+110 KILL ^TMP($JOB,"OR REMDLG"),@DATA
+111 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+112 QUIT
ADD(ARRAY,SUBSCRIPT,VALUE) ;ADD A LINE TO THE OUTPUT ARRAY
+1 ;PARAMETERS: ARRAY => NODE ADDRESS OF ARRAY TO STORE VALUE IN
+2 ; SUBSCRIPT => THE SUBSCRIPT DESCENDANT FROM ARRAY IN WHICH TO STORE VALUE IN
+3 ; VALUE => DATA TO STORE IN THE OUTPUT ARRAY
+4 IF VALUE["QUICK ORDER (IEN):"
SET @ARRAY@("COUNT",SUBSCRIPT)=1+$GET(@ARRAY@("COUNT",SUBSCRIPT))
+5 NEW LNUM,HOLDING,COLUMN
+6 SET COLUMN=$SELECT(VALUE'[":":4,1:24)
+7 DO WRAP^ORUTL(VALUE,"HOLDING",1,1,COLUMN)
+8 SET LNUM=1+$ORDER(@ARRAY@(SUBSCRIPT,@ARRAY@("COUNT",SUBSCRIPT),"?"),-1)
+9 SET HOLDING=0
FOR
SET HOLDING=$ORDER(HOLDING(HOLDING))
if 'HOLDING
QUIT
Begin DoDot:1
+10 SET @ARRAY@(SUBSCRIPT,@ARRAY@("COUNT",SUBSCRIPT),LNUM)=HOLDING(HOLDING)
+11 SET LNUM=1+LNUM
End DoDot:1
+12 QUIT
ALLDOSES(OROI,ORTYPE,ORPT,OROUT,ORDISP) ;return all doses for an orderable item
+1 NEW ORY
+2 SET ORDISP="NA"
+3 DO OISLCT^ORWDPS2(.ORY,OROI,ORTYPE,ORPT,"Y","Y")
+4 NEW I
SET I=0
FOR
SET I=$ORDER(ORY(I))
if 'I
QUIT
Begin DoDot:1
+5 IF ORY(I)="~AllDoses"
Begin DoDot:2
+6 FOR
SET I=$ORDER(ORY(I))
if 'I
QUIT
if $EXTRACT(ORY(I),1,1)="~"
QUIT
Begin DoDot:3
+7 SET OROUT($EXTRACT(ORY(I),2,$LENGTH($PIECE(ORY(I),U))))=""
End DoDot:3
End DoDot:2
+8 IF ORY(I)="~Dispense"
Begin DoDot:2
+9 FOR
SET I=$ORDER(ORY(I))
if 'I
QUIT
if $EXTRACT(ORY(I),1,1)="~"
QUIT
Begin DoDot:3
+10 SET ORDISP=ORY(I)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
CASE ;
+1 WRITE !!,"This report identifies quick orders that have potentially had the DRUG name",!
+2 WRITE "edited such that when the quick order is loaded in CPRS the dosage that is",!
+3 WRITE "saved with the quick order does not match any of the dosages available for",!
+4 WRITE "selection in the list. This causes the dosage checks not to be able to be",!
+5 WRITE "performed correctly. The edit to the drug that this specifically looks for",!
+6 WRITE "is a case change to the DRUG name. If the name is changed so that it",!
+7 WRITE "contains different characters that are not just case changes, this report",!
+8 WRITE "will not identify them.",!
+9 DO DEVICE^ORUTL("CASEQ^ORQOREP","OR QUICK ORDER MIXED-CASE","Q")
+10 QUIT
CASEQ ;TASKMAN ENTRY POINT
+1 NEW ORI,ORPT,ORCNT,STOP,PGNUM
+2 SET ORPT=$ORDER(^DPT(0))
SET ORCNT=0
+3 SET ORI=0
FOR
SET ORI=$ORDER(^ORD(101.41,ORI))
if 'ORI!($GET(STOP))
QUIT
Begin DoDot:1
+4 if ($PIECE(^ORD(101.41,ORI,0),U,4)'="Q")
QUIT
+5 NEW ORINSDLG,ORINSIEN,ORDRDLG,ORDRIEN,ORINS,ORDR,OROIDLG,OROIIEN,OROI,ORDREXT,ORFLAG,ORDG,ORPTYPE,ORDOSE,ORPSOI
+6 SET OROIDLG=$ORDER(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
+7 if 'OROIDLG
QUIT
+8 SET OROIIEN=$ORDER(^ORD(101.41,ORI,6,"D",OROIDLG,0))
+9 if 'OROIIEN
QUIT
+10 SET OROI=$GET(^ORD(101.41,ORI,6,OROIIEN,1))
+11 if 'OROI
QUIT
+12 if $PIECE($PIECE($GET(^ORD(101.43,OROI,0)),U,2),";",2)'="99PSP"
QUIT
+13 SET ORPSOI=$PIECE($PIECE($GET(^ORD(101.43,OROI,0)),U,2),";")
+14 SET ORINSDLG=$ORDER(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
+15 if 'ORINSDLG
QUIT
+16 SET ORINSIEN=$ORDER(^ORD(101.41,ORI,6,"D",ORINSDLG,0))
+17 if 'ORINSIEN
QUIT
+18 SET ORINS=$GET(^ORD(101.41,ORI,6,ORINSIEN,1))
+19 if $LENGTH(ORINS)=0
QUIT
+20 SET ORDRDLG=$ORDER(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0))
+21 if 'ORDRDLG
QUIT
+22 SET ORDRIEN=$ORDER(^ORD(101.41,ORI,6,"D",ORDRDLG,0))
+23 if 'ORDRIEN
QUIT
+24 SET ORDR=$GET(^ORD(101.41,ORI,6,ORDRIEN,1))
+25 if 'ORDR
QUIT
+26 SET ORDREXT=$$EXTVAL^ORWDX2(ORDR,ORDRDLG)
+27 ;GET DISPLAY GROUP
+28 SET ORDG=$PIECE($GET(^ORD(101.41,ORI,0)),U,5)
+29 SET ORDG=$PIECE($GET(^ORD(100.98,ORDG,0)),U)
+30 SET ORPTYPE=$SELECT(ORDG="UNIT DOSE MEDICATIONS":"I",1:"O")
+31 IF '$LENGTH($TEXT(DOSE^PSSOPKI1))
DO DOSE^PSSORUTL(.ORDOSE,ORPSOI,ORPTYPE,ORPT)
+32 IF $LENGTH($TEXT(DOSE^PSSOPKI1))
DO DOSE^PSSOPKI1(.ORDOSE,ORPSOI,ORPTYPE,ORPT)
+33 NEW ORFOUND,ORDOSEI
SET ORDOSEI=0
SET ORFOUND=0
+34 FOR
SET ORDOSEI=$ORDER(ORDOSE(ORDOSEI))
if 'ORDOSEI
QUIT
Begin DoDot:2
+35 IF ORINS[$PIECE(ORDOSE(ORDOSEI),U,5)
SET ORFOUND=1
End DoDot:2
+36 IF ORINS[$PIECE($GET(ORDOSE("DD",ORDR)),U)
QUIT
+37 SET ORFLAG=""
+38 if ORINS[ORDREXT
QUIT
+39 if $$UPPER^ORU(ORINS)'[$$UPPER^ORU(ORDREXT)
QUIT
+40 IF ($Y+CBUFFER+8)>IOSL!($Y=0)
SET STOP=$$HEADER^ORUTL("QUICK ORDER MIXED-CASE REPORT",.PGNUM)
+41 if $GET(STOP)
QUIT
+42 WRITE "QUICK ORDER (IEN):",?24,$PIECE(^ORD(101.41,ORI,0),U,2)," (",ORI,")"
+43 WRITE !,?2,"DISPLAY GROUP: ",?24,ORDG
+44 WRITE !,?2,"ORDERABLE ITEM IEN:",?24,OROI
+45 WRITE !,?2,"ORDERABLE ITEM NAME:",?24,$PIECE(^ORD(101.43,OROI,0),U)
+46 WRITE !,?2,"DRUG IEN:",?24,ORDR
+47 WRITE !,?2,"DRUG TEXT:",?24,ORDREXT
+48 WRITE !,?2,"QO INSTRUCTIONS:",?24,ORINS
+49 IF $Y<IOSL
WRITE !
+50 SET ORCNT=ORCNT+1
End DoDot:1
+51 IF '$GET(STOP)
Begin DoDot:1
+52 IF ($Y+CBUFFER+2)>IOSL!($Y=0)
SET STOP=$$HEADER^ORUTL("QUICK ORDER MIXED-CASE REPORT",.PGNUM)
+53 if STOP
QUIT
+54 WRITE !,$$CJ^XLFSTR(ORCNT_" Quick Orders Found",$SELECT(+$GET(IOM)>0:(IOM-1),1:79)," ")
End DoDot:1
+55 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+56 QUIT
