Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORQOREP

ORQOREP.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. DIFF ;
  1. W !!,"This report identifies Medication Quick orders that have a free text dosage",!
  1. W "that does not match exactly one of the Local Dosages from Pharmacy.",!
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,TYPE,SAVE
  1. S DIR(0)="S"_U_"S:System Quick Orders;P:Personal Quick Orders;PS:Personal and System Quick Orders"
  1. S DIR("A")="SELECT THE TYPE OF QUICK ORDER",DIR("B")="PS" D ^DIR
  1. Q:"PS"'[$G(Y)
  1. S TYPE="I $P($G(^ORD(101.41,ORI,0)),U,4)=""Q"""
  1. I Y="P" S TYPE=TYPE_",($E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)=""ORWDQ "")"
  1. I Y="S" S TYPE=TYPE_",($E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)'=""ORWDQ "")"
  1. K DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="S"_U_"L:Local Possible Dosages;P:Possible Dosages;N:No Local Possible and No Possible Dosages"
  1. S DIR("A")="SELECT THE TYPE OF DOSAGE",DIR("B")="L" D ^DIR
  1. Q:"^L^P^N^"'[(U_$G(Y)_U)
  1. S ORY=Y
  1. S SAVE("TYPE")="",SAVE("ORY")=""
  1. D DEVICE^ORUTL("DIFFQ^ORQOREP","OR QUICK ORDER FREE-TEXT","Q",.SAVE)
  1. Q
  1. DIFFQ ;TASKMAN ENTRY POINT
  1. ;return list of quick orders in a reminder dialog
  1. K ^TMP($J,"OR REMDLG")
  1. D FQOIRDLG^ORINQIV
  1. N ORI,ORPT,ORCNT,DATA,EXIT,STOP,PGNUM,OUT,DOSAGE
  1. S ORPT=$O(^DPT(0)),ORCNT=0,DATA=$NA(^TMP($J,"ORQOREP")) K @DATA
  1. S OUT(1)="This report identifies medication quick orders that have a free text dosage"
  1. S OUT(2)="that does not exactly match one of the local possible dosages from pharmacy.",OUT=3
  1. I ORY'="N" D
  1. .S DOSAGE="I $L($P(ORDOSE(ORDLI),U))>0,($L($P(ORDOSE(ORDLI),U,3))>0)"
  1. .S OUT(OUT)="When at least one active dispense drug linked to the orderable item has a",OUT=OUT+1
  1. .S OUT(OUT)="possible dosage then only possible dosages will be available in CPRS and",OUT=OUT+1
  1. .S OUT(OUT)="for dose checks for the package (I/O) of the quick order. "
  1. .I ORY="L" D
  1. ..S DOSAGE=$TR(DOSAGE,">","=")
  1. ..S OUT(OUT)=OUT(OUT)_"Thus, no possible",OUT=OUT+1
  1. ..S OUT(OUT)="dosages have been created and only local possible dosages are listed below."
  1. .I ORY="P" D
  1. ..S OUT(OUT)=OUT(OUT)_"Thus, local",OUT=OUT+1
  1. ..S OUT(OUT)="possible dosages for a dispense drug will not be listed below, only possible",OUT=OUT+1
  1. ..S OUT(OUT)="dosages are listed.",OUT=OUT+1
  1. I ORY="N" D
  1. .S OUT(OUT)="It shows when all of the active dispense drugs linked to the orderable",OUT=OUT+1
  1. .S OUT(OUT)="item have NO possible dosages and NO local possible dosages for the",OUT=OUT+1
  1. .S OUT(OUT)="package (I/O) of the quick order."
  1. S ORI=0 F S ORI=$O(^ORD(101.41,ORI)) Q:'ORI D
  1. .X TYPE Q:'$T
  1. .N CONT,USER
  1. .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)
  1. .Q:'CONT
  1. .;FOR PERSONAL QUICK ORDERS, STOP EXAMINING IF ALL ASSOCIATED USERS ARE INACTIVE
  1. .S EXIT=0
  1. .I $E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)="ORWDQ " D
  1. ..N OQVIEN S OQVIEN=0,EXIT=1
  1. ..F S OQVIEN=$O(^ORD(101.44,"C",ORI,OQVIEN)) Q:+$G(OQVIEN)=0 D
  1. ...S USER=$P($P($G(^ORD(101.44,OQVIEN,0)),U,1)," ",2),USER=$E(USER,4,$L(USER))
  1. ...S USER(USER)=+$$ACTIVE^XUSER(USER)
  1. ...S:EXIT EXIT='USER(USER)
  1. ...I 'USER(USER) K USER(USER)
  1. ...I $D(USER(USER)) S USER(USER)=$$GET1^DIQ(200,USER_",",.01)
  1. .Q:+EXIT
  1. .N ORINSDLG,ORINSIEN,ORDRDLG,ORDRIEN,ORINS,ORDR,OROIDLG,OROIIEN,OROI,ORDREXT,ORFLAG,ORDG,ORPTYPE,ORDOSE,ORPSOI
  1. .S OROIDLG=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
  1. .Q:'OROIDLG
  1. .S OROIIEN=$O(^ORD(101.41,ORI,6,"D",OROIDLG,0))
  1. .Q:'OROIIEN
  1. .S OROI=$G(^ORD(101.41,ORI,6,OROIIEN,1))
  1. .Q:'OROI
  1. .Q:$P($P($G(^ORD(101.43,OROI,0)),U,2),";",2)'="99PSP"
  1. .S ORPSOI=$P($P($G(^ORD(101.43,OROI,0)),U,2),";")
  1. .S ORINSDLG=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
  1. .Q:'ORINSDLG
  1. .S ORINSIEN=$O(^ORD(101.41,ORI,6,"D",ORINSDLG,0))
  1. .Q:'ORINSIEN
  1. .S ORINS=$G(^ORD(101.41,ORI,6,ORINSIEN,1))
  1. .Q:$L(ORINS)=0
  1. .;GET DISPLAY GROUP
  1. .S ORDG=$P($G(^ORD(101.41,ORI,0)),U,5)
  1. .S ORDG=$P($G(^ORD(100.98,ORDG,0)),U)
  1. .S ORPTYPE=$S(ORDG="UNIT DOSE MEDICATIONS":"U",ORDG="NON-VA MEDICATIONS":"X",ORDG="IV MEDICATIONS":"I",1:"O")
  1. .N ORDOSE2,ORDISP D ALLDOSES(OROI,ORPTYPE,ORPT,.ORDOSE2,.ORDISP)
  1. .N ORDOSE D DOSE^PSSOPKI1(.ORDOSE,ORPSOI,ORPTYPE)
  1. .I $D(DOSAGE),('$D(ORDOSE(1))) Q
  1. .I '$D(DOSAGE),($D(ORDOSE(1))) Q
  1. .I $D(DOSAGE) D
  1. ..N ORDLI S ORDLI=0,EXIT=1
  1. ..F S ORDLI=$O(ORDOSE(ORDLI)) Q:'ORDLI!('EXIT) D
  1. ...X DOSAGE S EXIT='$T
  1. .Q:+$G(EXIT)
  1. .Q:$D(ORDOSE2(ORINS))
  1. .N OREXMPT,OREI
  1. .S OREXMPT=1,OREI=0 F S OREI=$O(ORDOSE("DD",OREI)) Q:'OREI I '$$EXMT^PSSDSAPI(OREI) S OREXMPT=0
  1. .S:'$D(DOSAGE) OREXMPT=0
  1. .Q:OREXMPT
  1. .N SUBSCRIPT
  1. .S SUBSCRIPT=$S($E($P($G(^ORD(101.41,ORI,0)),U,1),1,6)="ORWDQ ":"PERSONAL",1:"SYSTEM")
  1. .D ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR("QUICK ORDER (IEN):",24," ")_$P(^ORD(101.41,ORI,0),U)_" ("_ORI_")")
  1. .D ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR("QO DISPLAY NAME:",24," ")_$P(^ORD(101.41,ORI,0),U,2))
  1. .I $D(USER)>9 D
  1. ..N HEADER S HEADER=" OWNER(S): "
  1. ..S USER=0 F S USER=$O(USER(USER)) Q:+$G(USER)=0 D
  1. ...D ADD(DATA,SUBSCRIPT,$$LJ^XLFSTR(HEADER,24," ")_USER(USER))
  1. ...S:HEADER'=" " HEADER=" "
  1. .D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("DISPLAY GROUP:",22," ")_ORDG)
  1. .D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("ORDERABLE ITEM IEN:",22," ")_OROI)
  1. .D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("ORDERABLE ITEM NAME:",22," ")_$P(^ORD(101.43,OROI,0),U))
  1. .D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("QO INSTRUCTIONS:",22," ")_$E(ORINS,1,50))
  1. .D ADD(DATA,SUBSCRIPT," "_$$LJ^XLFSTR("DISPENSE:",22," ")_$P(ORDISP,U,4))
  1. .I $L(ORINS)>50 D ADD(DATA,SUBSCRIPT," "_$$REPEAT^XLFSTR(" ",22)_$E(ORINS,50,$L(ORINS)))
  1. .D ADD(DATA,SUBSCRIPT," CPRS DOSAGE LIST:")
  1. .N ORDI S ORDI="" F S ORDI=$O(ORDOSE2(ORDI)) Q:ORDI="" D ADD(DATA,SUBSCRIPT," "_ORDI)
  1. .D ADD(DATA,SUBSCRIPT,"")
  1. .S ORCNT=ORCNT+1
  1. S STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
  1. Q:STOP
  1. S OUT=0 F S OUT=$O(OUT(OUT)) Q:'OUT W OUT(OUT),!
  1. W !
  1. N COUNT,LINE
  1. F SUBSCRIPT="SYSTEM","PERSONAL" Q:STOP D
  1. .F COUNT=1:1:+$G(@DATA@("COUNT",SUBSCRIPT)) Q:STOP D
  1. ..I ($Y+CBUFFER+$O(@DATA@(SUBSCRIPT,COUNT,"?"),-1))>IOSL S STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
  1. ..Q:STOP
  1. ..S LINE=0 F S LINE=$O(@DATA@(SUBSCRIPT,COUNT,LINE)) Q:+$G(LINE)=0!(STOP) D
  1. ...W @DATA@(SUBSCRIPT,COUNT,LINE)
  1. ...I ($Y+CBUFFER)<IOSL W !
  1. ...I ($Y+CBUFFER)=IOSL S STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
  1. I 'STOP D
  1. .I ($Y+CBUFFER+2)>IOSL S STOP=$$HEADER^ORUTL("QUICK ORDER FREE-TEXT REPORT",.PGNUM)
  1. .Q:STOP
  1. .W !,$$CJ^XLFSTR(ORCNT_" Quick Orders Found",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
  1. K ^TMP($J,"OR REMDLG"),@DATA
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. ADD(ARRAY,SUBSCRIPT,VALUE) ;ADD A LINE TO THE OUTPUT ARRAY
  1. ;PARAMETERS: ARRAY => NODE ADDRESS OF ARRAY TO STORE VALUE IN
  1. ; SUBSCRIPT => THE SUBSCRIPT DESCENDANT FROM ARRAY IN WHICH TO STORE VALUE IN
  1. ; VALUE => DATA TO STORE IN THE OUTPUT ARRAY
  1. I VALUE["QUICK ORDER (IEN):" S @ARRAY@("COUNT",SUBSCRIPT)=1+$G(@ARRAY@("COUNT",SUBSCRIPT))
  1. N LNUM,HOLDING,COLUMN
  1. S COLUMN=$S(VALUE'[":":4,1:24)
  1. D WRAP^ORUTL(VALUE,"HOLDING",1,1,COLUMN)
  1. S LNUM=1+$O(@ARRAY@(SUBSCRIPT,@ARRAY@("COUNT",SUBSCRIPT),"?"),-1)
  1. S HOLDING=0 F S HOLDING=$O(HOLDING(HOLDING)) Q:'HOLDING D
  1. .S @ARRAY@(SUBSCRIPT,@ARRAY@("COUNT",SUBSCRIPT),LNUM)=HOLDING(HOLDING)
  1. .S LNUM=1+LNUM
  1. Q
  1. ALLDOSES(OROI,ORTYPE,ORPT,OROUT,ORDISP) ;return all doses for an orderable item
  1. N ORY
  1. S ORDISP="NA"
  1. D OISLCT^ORWDPS2(.ORY,OROI,ORTYPE,ORPT,"Y","Y")
  1. N I S I=0 F S I=$O(ORY(I)) Q:'I D
  1. .I ORY(I)="~AllDoses" D
  1. ..F S I=$O(ORY(I)) Q:'I Q:$E(ORY(I),1,1)="~" D
  1. ...S OROUT($E(ORY(I),2,$L($P(ORY(I),U))))=""
  1. .I ORY(I)="~Dispense" D
  1. ..F S I=$O(ORY(I)) Q:'I Q:$E(ORY(I),1,1)="~" D
  1. ...S ORDISP=ORY(I)
  1. Q
  1. CASE ;
  1. W !!,"This report identifies quick orders that have potentially had the DRUG name",!
  1. W "edited such that when the quick order is loaded in CPRS the dosage that is",!
  1. W "saved with the quick order does not match any of the dosages available for",!
  1. W "selection in the list. This causes the dosage checks not to be able to be",!
  1. W "performed correctly. The edit to the drug that this specifically looks for",!
  1. W "is a case change to the DRUG name. If the name is changed so that it",!
  1. W "contains different characters that are not just case changes, this report",!
  1. W "will not identify them.",!
  1. D DEVICE^ORUTL("CASEQ^ORQOREP","OR QUICK ORDER MIXED-CASE","Q")
  1. Q
  1. CASEQ ;TASKMAN ENTRY POINT
  1. N ORI,ORPT,ORCNT,STOP,PGNUM
  1. S ORPT=$O(^DPT(0)),ORCNT=0
  1. S ORI=0 F S ORI=$O(^ORD(101.41,ORI)) Q:'ORI!($G(STOP)) D
  1. .Q:($P(^ORD(101.41,ORI,0),U,4)'="Q")
  1. .N ORINSDLG,ORINSIEN,ORDRDLG,ORDRIEN,ORINS,ORDR,OROIDLG,OROIIEN,OROI,ORDREXT,ORFLAG,ORDG,ORPTYPE,ORDOSE,ORPSOI
  1. .S OROIDLG=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
  1. .Q:'OROIDLG
  1. .S OROIIEN=$O(^ORD(101.41,ORI,6,"D",OROIDLG,0))
  1. .Q:'OROIIEN
  1. .S OROI=$G(^ORD(101.41,ORI,6,OROIIEN,1))
  1. .Q:'OROI
  1. .Q:$P($P($G(^ORD(101.43,OROI,0)),U,2),";",2)'="99PSP"
  1. .S ORPSOI=$P($P($G(^ORD(101.43,OROI,0)),U,2),";")
  1. .S ORINSDLG=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
  1. .Q:'ORINSDLG
  1. .S ORINSIEN=$O(^ORD(101.41,ORI,6,"D",ORINSDLG,0))
  1. .Q:'ORINSIEN
  1. .S ORINS=$G(^ORD(101.41,ORI,6,ORINSIEN,1))
  1. .Q:$L(ORINS)=0
  1. .S ORDRDLG=$O(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0))
  1. .Q:'ORDRDLG
  1. .S ORDRIEN=$O(^ORD(101.41,ORI,6,"D",ORDRDLG,0))
  1. .Q:'ORDRIEN
  1. .S ORDR=$G(^ORD(101.41,ORI,6,ORDRIEN,1))
  1. .Q:'ORDR
  1. .S ORDREXT=$$EXTVAL^ORWDX2(ORDR,ORDRDLG)
  1. .;GET DISPLAY GROUP
  1. .S ORDG=$P($G(^ORD(101.41,ORI,0)),U,5)
  1. .S ORDG=$P($G(^ORD(100.98,ORDG,0)),U)
  1. .S ORPTYPE=$S(ORDG="UNIT DOSE MEDICATIONS":"I",1:"O")
  1. .I '$L($T(DOSE^PSSOPKI1)) D DOSE^PSSORUTL(.ORDOSE,ORPSOI,ORPTYPE,ORPT)
  1. .I $L($T(DOSE^PSSOPKI1)) D DOSE^PSSOPKI1(.ORDOSE,ORPSOI,ORPTYPE,ORPT)
  1. .N ORFOUND,ORDOSEI S ORDOSEI=0,ORFOUND=0
  1. .F S ORDOSEI=$O(ORDOSE(ORDOSEI)) Q:'ORDOSEI D
  1. ..I ORINS[$P(ORDOSE(ORDOSEI),U,5) S ORFOUND=1
  1. .I ORINS[$P($G(ORDOSE("DD",ORDR)),U) Q
  1. .S ORFLAG=""
  1. .Q:ORINS[ORDREXT
  1. .Q:$$UPPER^ORU(ORINS)'[$$UPPER^ORU(ORDREXT)
  1. .I ($Y+CBUFFER+8)>IOSL!($Y=0) S STOP=$$HEADER^ORUTL("QUICK ORDER MIXED-CASE REPORT",.PGNUM)
  1. .Q:$G(STOP)
  1. .W "QUICK ORDER (IEN):",?24,$P(^ORD(101.41,ORI,0),U,2)," (",ORI,")"
  1. .W !,?2,"DISPLAY GROUP: ",?24,ORDG
  1. .W !,?2,"ORDERABLE ITEM IEN:",?24,OROI
  1. .W !,?2,"ORDERABLE ITEM NAME:",?24,$P(^ORD(101.43,OROI,0),U)
  1. .W !,?2,"DRUG IEN:",?24,ORDR
  1. .W !,?2,"DRUG TEXT:",?24,ORDREXT
  1. .W !,?2,"QO INSTRUCTIONS:",?24,ORINS
  1. .I $Y<IOSL W !
  1. .S ORCNT=ORCNT+1
  1. I '$G(STOP) D
  1. .I ($Y+CBUFFER+2)>IOSL!($Y=0) S STOP=$$HEADER^ORUTL("QUICK ORDER MIXED-CASE REPORT",.PGNUM)
  1. .Q:STOP
  1. .W !,$$CJ^XLFSTR(ORCNT_" Quick Orders Found",$S(+$G(IOM)>0:(IOM-1),1:79)," ")
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. Q