- 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 Feb 18, 2025@23:59:53 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