ORY94 ;SLC/MKB -- post-install for OR*3*94;02:56 PM 8 May 2001
;;3.0;ORDER ENTRY/RESULTS REPORTING;**94**;Dec 17, 1997
;
PRE ; -- preinit for patch 94
I $O(^ORD(101.41,"AB","PS MEDS",0)) Q ;not first install
N ORNOW S ORNOW=$$NOW^XLFDT
S ^XTMP("OR94",0)=$$FMADD^XLFDT(ORNOW,90)_U_ORNOW_"^OR*3*94 Conversion"
S ^XTMP("OR94","DUZ")=DUZ,^("DLG")=0,^("PAT")=""
K ^XTMP("ORPSO"),^XTMP("ORIT"),^XTMP("ORDER")
Q
;
EN ; -- postinit for patch 94
N NAME,DLG,ITM,PTR
F NAME="PS MEDS","PSJ OR PAT OE","PSO OERR","PSO SUPPLY" D
. S DLG=+$O(^ORD(101.41,"AB",NAME,0)) Q:DLG'>0
. S PTR=+$$PTR("DRUG NAME") F ITM="ORDERABLE ITEM","STRENGTH" D
.. S ITM=+$$PTR(ITM),ITM=+$O(^ORD(101.41,DLG,10,"D",ITM,0))
.. I ITM,PTR S $P(^ORD(101.41,DLG,10,ITM,2),U,2)="@"_PTR
D ID,DLGS
Q
;
ID ; -- Look for OI's with duplicate ID's, inactivate extras
N ORID,ORNOW,DA,DR,DIE S ORNOW=+$E($$NOW^XLFDT,1,12)
S ORID="" F S ORID=$O(^ORD(101.43,"ID",ORID)) Q:ORID="" D
. S DA=$O(^ORD(101.43,"ID",ORID,0)) Q:'$O(^(DA)) ;no dup's
. F S DA=$O(^ORD(101.43,"ID",ORID,DA)) Q:DA'>0 D
.. I $G(^ORD(101.43,DA,.1)),^(.1)<ORNOW Q ;already inactive
.. S DIE="^ORD(101.43,",DR=".1////"_ORNOW D ^DIE
Q
;
DLGS ; -- Look for local PS dialogs that will need to be updated
N PSJ,PSO,ORPKG,ORDLG,OR0,ORZ,CNT
S PSJ=+$O(^DIC(9.4,"C","PSJ",0)),PSO=+$O(^DIC(9.4,"C","PSO",0))
S ORZ(1)="The order dialogs for medications, PSJ OR PAT OE and PSO OERR, have been"
S ORZ(2)="modified in this patch; please review and compare the following local"
S ORZ(3)="copies of these dialogs for changes:",CNT=3
F ORPKG=PSJ,PSO S ORDLG=0 D
. F S ORDLG=+$O(^ORD(101.41,"APKG",ORPKG,ORDLG)) Q:ORDLG'>0 D
.. S OR0=$G(^ORD(101.41,ORDLG,0)) Q:$P(OR0,U,4)'="D" ;ck dialogs only
.. I ORPKG=PSJ Q:$P(OR0,U)="PSJ OR PAT OE"
.. I ORPKG=PSO Q:$P(OR0,U)="PSO OERR" Q:$P(OR0,U)="PSO SUPPLY"
.. S CNT=CNT+1,ORZ(CNT)=$J(ORDLG,7)_" "_$P(OR0,U)
DLG1 I $O(ORZ(3)) D ;send bulletin
. N XMDUZ,XMY,I,XMSUB,XMTEXT,DIFROM
. S XMDUZ="PATCH OR*3*94 POSTINIT",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
. I '$G(DUZ) S I=$G(^XTMP("OR94","DUZ")) S:I XMY(I)=""
. S XMSUB="PATCH OR*3*94 POSTINIT COMPLETED"
. S XMTEXT="ORZ(" D ^XMD
. D BMES^XPDUTL("The order dialogs for medications have been modified in this patch;")
. D MES^XPDUTL("a bulletin has been sent to the installer listing local copies that")
. D MES^XPDUTL("may need to be reviewed and updated.")
Q
;
POST ; -- postinit for MOAB
D IVM,QO
Q
;
IVM ; -- build S.IVM RX xref
N ORNM,ORIT
S ORNM="" F S ORNM=$O(^ORD(101.43,"S.UD RX",ORNM)) Q:ORNM="" D
. S ORIT=0 F S ORIT=+$O(^ORD(101.43,"S.UD RX",ORNM,ORIT)) Q:ORIT'>0 I '$G(^(ORIT)),$P($G(^ORD(101.43,ORIT,"PS")),U)=2 D SET^ORDD43("IVM RX",ORIT)
Q
;
FIRST() ; -- first install of this patch?
N Y S Y=$G(^XTMP("OR94","DUZ")) ;set in pre-init if first install
Q Y
;
QO ; -- check med QO's for inactive orderables, old OP doses
;
Q:'$$FIRST ;conversion already run
;
N ORODG,ORGRP,ORNOW,ORPOI,ORPDD,ORPIN,ORPFT,ORPST,ORPID,ORPAD,ORQDLG,OR0,ORDIALOG,ORIT,ORDRUG,ORPSOI,ORP,ORI,ORXX
S ORODG=+$O(^ORD(100.98,"B","PHARMACY",0)) D DG^ORCHANG1(ORODG,"BILD",.ORGRP)
S ORODG=+$O(^ORD(100.98,"B","O RX",0)),ORNOW=$$NOW^XLFDT
S ORPOI=+$$PTR("ORDERABLE ITEM"),ORPDD=+$$PTR("DISPENSE DRUG")
S ORPIN=+$$PTR("INSTRUCTIONS"),ORPFT=+$$PTR("FREE TEXT")
S ORPST=+$$PTR("STRENGTH"),ORPID=+$$PTR("DOSE"),ORPAD=+$$PTR("ADDITIVE")
QO1 S ORQDLG=+$G(^XTMP("OR94","DLG")) ;find where left off, if restarted
F S ORQDLG=+$O(^ORD(101.41,ORQDLG)) Q:ORQDLG'>0 S OR0=$G(^(ORQDLG,0)) D
. Q:$P(OR0,U,4)'="Q" Q:'$D(ORGRP(+$P(OR0,U,5))) ;pharmacy qo's only
. K ORDIALOG,ORXX,^TMP("ORWORD",$J) D GETQDLG Q:'$D(ORDIALOG)
. S ORDRUG=+$G(ORDIALOG(ORPDD,1))
. ;
. ; -- Update inactive OI's, if possible
. F ORP=ORPOI,ORPAD S ORI=0 F S ORI=$O(ORDIALOG(ORP,ORI)) Q:ORI'>0 D
.. N ORITM,ORPSITM,ORNEWOI
.. S ORITM=+$G(ORDIALOG(ORP,ORI)) Q:ORITM'>0
.. Q:'$G(^ORD(101.43,ORITM,.1))!($G(^(.1))>ORNOW) ;still active
.. S ORPSITM=+$P($G(^ORD(101.43,ORITM,0)),U,2)
.. S ORNEWOI=$$EN^PSSQORD(ORPSITM,ORDRUG)
.. I ORNEWOI>0,$P(ORNEWOI,U,2)!($P(ORNEWOI,U,3)>ORNOW) S ORNEWOI=+$O(^ORD(101.43,"ID",+ORNEWOI_";99PSP",0)) S:ORNEWOI ORDIALOG(ORP,ORI)=ORNEWOI,ORXX=1 Q
.. S ^XTMP("ORIT",ORQDLG)="" ;list unconverted qo's for bulletin
. ;
QO2 . ; -- Update Outpt instructions, if possible
. S ORIT=+$G(ORDIALOG(ORPOI,1)),ORPSOI=+$P($G(^ORD(101.43,ORIT,0)),U,2)
. I $P(OR0,U,5)=ORODG D
.. N ORDOSE,ORI,DRUG,STR D DOSE^PSSORUTL(.ORDOSE,ORPSOI,"O","")
.. S DRUG=$G(ORDOSE("DD",ORDRUG)),STR=$P(DRUG,U,5,6) ;"" if no ORDRUG
.. S ORI=0 F S ORI=$O(ORDIALOG(ORPIN,ORI)) Q:ORI'>0 D DOSE
.. S STR=$TR(STR,"^") I STR,$P($G(^ORD(101.43,ORIT,0)),U)'[STR S ORDIALOG(ORPST,1)=STR
.. ;set Drug Name if needed too?
. ;
. ; -- Save changes to quick order
. I $G(ORXX) D SAVE^ORCMEDT0 ;save responses if changed
. S ^XTMP("OR94","DLG")=ORQDLG
;
QO3 ; -- Update inactive OI's in delayed orders, if possible
D QO3^ORY94A
D BULLETIN^ORY94A
K ^TMP("ORWORD",$J),^TMP("ORTXT",$J),^XTMP("OR94")
Q
;
PTR(X) ; -- Return ptr to prompt OR GTX X
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
;
GETQDLG ; -- Get quick order definition, build ORDIALOG()
S ORDIALOG=+$$DEFDLG^ORCD(ORQDLG) Q:'ORDIALOG
D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD("^ORD(101.41,"_ORQDLG_",6)")
; -- set additional nodes for old Noun prompt
N I,J,X
S I=0 F S I=$O(^ORD(101.41,ORQDLG,6,"D",ORPFT,I)) Q:I'>0 D
. S J=+$P($G(^ORD(101.41,ORQDLG,6,I,0)),U,3),X=$G(^(1))
. S:$D(ORDIALOG(ORPIN,J)) ORDIALOG(ORPFT,J)=X
Q
;
DOSE ; -- Reformat outpt dose instance ORI, if possible/necessary
Q:$D(ORDIALOG(ORPID,ORI)) ;already successfully converted
N UD,UNT,CONJ,IDX,DOSE,MATCH,X,Y
S UD=$G(ORDIALOG(ORPIN,ORI)),UNT=$G(ORDIALOG(ORPFT,ORI)),MATCH=0
S:UD="1/2" UD=.5 S:UD="1/3" UD=.33 S:UD="1/4" UD=.25 S:UD="3/4" UD=.75
I UNT?1.U1"(S)" S UNT=$P(UNT,"(")_$S(UD>1:"S",1:"") ;strip trailing (s)
S CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
S IDX="ORDOSE(0)" F S IDX=$Q(@IDX) Q:IDX'?1"ORDOSE("1.N.",".N1")" D
. S DOSE=@IDX,X=UD_$S('$L(UNT):"",$P(DOSE,U,3):"^"_UNT,1:" "_UNT)
. S X=$$UP^XLFSTR(X) I ($P(DOSE,U,3,4)=X)!($P(DOSE,U,5)=X) D
.. I ORDRUG,$P(DOSE,U,6)'=ORDRUG Q ;not a match
.. S MATCH=MATCH+1,MATCH(MATCH)=$P(DOSE,U,1,6)
D1 K ORDIALOG(ORPFT,ORI) S ORXX=1
I MATCH=1 D Q ;Update responses
. S Y=MATCH(1),X=$P(Y,U,5)
. S:'Y X=X_CONJ_" "_$S($G(STR):$TR(STR,"^"),1:$P(DRUG,U))
. S ORDIALOG(ORPIN,ORI)=X
. S ORDIALOG(ORPDD,ORI)=$P(Y,U,6)
. S ORDIALOG(ORPID,ORI)=$TR(Y,"^","&")_"&"_$TR($G(STR),"^","&")
; -- Else save free text instructions, add qo to bulletin for review
S ORDIALOG(ORPIN,ORI)=UD_$S($L(UNT):" "_UNT,1:"")
;K ORDIALOG(ORPDD,ORI) ;clear old dispense drug?
S ^XTMP("ORPSO",ORQDLG)=""
Q
;
BULLETIN ; -- Send bulletin containing qo's we couldn't convert
D BULLETIN^ORY94A ;just in case
Q
;
DLGSEND(ANAME) ; -- Return true if the order dialog should be sent
I ANAME="OR GTX AND/THEN" Q 1
I ANAME="OR GTX DAYS SUPPLY" Q 1
I ANAME="OR GTX DOSE" Q 1
I ANAME="OR GTX DRUG NAME" Q 1
I ANAME="OR GTX INSTRUCTIONS" Q 1
I ANAME="OR GTX NOW" Q 1
I ANAME="OR GTX ORDERABLE ITEM" Q 1
I ANAME="OR GTX PATIENT INSTRUCTIONS" Q 1
I ANAME="OR GTX SIG" Q 1
I ANAME="OR GTX STRENGTH" Q 1
I ANAME="PS MEDS" Q 1
I ANAME="PSJ OR PAT OE" Q 1
I ANAME="PSO OERR" Q 1
I ANAME="PSO SUPPLY" Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY94 7499 printed Nov 22, 2024@17:53:11 Page 2
ORY94 ;SLC/MKB -- post-install for OR*3*94;02:56 PM 8 May 2001
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94**;Dec 17, 1997
+2 ;
PRE ; -- preinit for patch 94
+1 ;not first install
IF $ORDER(^ORD(101.41,"AB","PS MEDS",0))
QUIT
+2 NEW ORNOW
SET ORNOW=$$NOW^XLFDT
+3 SET ^XTMP("OR94",0)=$$FMADD^XLFDT(ORNOW,90)_U_ORNOW_"^OR*3*94 Conversion"
+4 SET ^XTMP("OR94","DUZ")=DUZ
SET ^("DLG")=0
SET ^("PAT")=""
+5 KILL ^XTMP("ORPSO"),^XTMP("ORIT"),^XTMP("ORDER")
+6 QUIT
+7 ;
EN ; -- postinit for patch 94
+1 NEW NAME,DLG,ITM,PTR
+2 FOR NAME="PS MEDS","PSJ OR PAT OE","PSO OERR","PSO SUPPLY"
Begin DoDot:1
+3 SET DLG=+$ORDER(^ORD(101.41,"AB",NAME,0))
if DLG'>0
QUIT
+4 SET PTR=+$$PTR("DRUG NAME")
FOR ITM="ORDERABLE ITEM","STRENGTH"
Begin DoDot:2
+5 SET ITM=+$$PTR(ITM)
SET ITM=+$ORDER(^ORD(101.41,DLG,10,"D",ITM,0))
+6 IF ITM
IF PTR
SET $PIECE(^ORD(101.41,DLG,10,ITM,2),U,2)="@"_PTR
End DoDot:2
End DoDot:1
+7 DO ID
DO DLGS
+8 QUIT
+9 ;
ID ; -- Look for OI's with duplicate ID's, inactivate extras
+1 NEW ORID,ORNOW,DA,DR,DIE
SET ORNOW=+$EXTRACT($$NOW^XLFDT,1,12)
+2 SET ORID=""
FOR
SET ORID=$ORDER(^ORD(101.43,"ID",ORID))
if ORID=""
QUIT
Begin DoDot:1
+3 ;no dup's
SET DA=$ORDER(^ORD(101.43,"ID",ORID,0))
if '$ORDER(^(DA))
QUIT
+4 FOR
SET DA=$ORDER(^ORD(101.43,"ID",ORID,DA))
if DA'>0
QUIT
Begin DoDot:2
+5 ;already inactive
IF $GET(^ORD(101.43,DA,.1))
IF ^(.1)<ORNOW
QUIT
+6 SET DIE="^ORD(101.43,"
SET DR=".1////"_ORNOW
DO ^DIE
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
DLGS ; -- Look for local PS dialogs that will need to be updated
+1 NEW PSJ,PSO,ORPKG,ORDLG,OR0,ORZ,CNT
+2 SET PSJ=+$ORDER(^DIC(9.4,"C","PSJ",0))
SET PSO=+$ORDER(^DIC(9.4,"C","PSO",0))
+3 SET ORZ(1)="The order dialogs for medications, PSJ OR PAT OE and PSO OERR, have been"
+4 SET ORZ(2)="modified in this patch; please review and compare the following local"
+5 SET ORZ(3)="copies of these dialogs for changes:"
SET CNT=3
+6 FOR ORPKG=PSJ,PSO
SET ORDLG=0
Begin DoDot:1
+7 FOR
SET ORDLG=+$ORDER(^ORD(101.41,"APKG",ORPKG,ORDLG))
if ORDLG'>0
QUIT
Begin DoDot:2
+8 ;ck dialogs only
SET OR0=$GET(^ORD(101.41,ORDLG,0))
if $PIECE(OR0,U,4)'="D"
QUIT
+9 IF ORPKG=PSJ
if $PIECE(OR0,U)="PSJ OR PAT OE"
QUIT
+10 IF ORPKG=PSO
if $PIECE(OR0,U)="PSO OERR"
QUIT
if $PIECE(OR0,U)="PSO SUPPLY"
QUIT
+11 SET CNT=CNT+1
SET ORZ(CNT)=$JUSTIFY(ORDLG,7)_" "_$PIECE(OR0,U)
End DoDot:2
End DoDot:1
DLG1 ;send bulletin
IF $ORDER(ORZ(3))
Begin DoDot:1
+1 NEW XMDUZ,XMY,I,XMSUB,XMTEXT,DIFROM
+2 SET XMDUZ="PATCH OR*3*94 POSTINIT"
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+3 IF '$GET(DUZ)
SET I=$GET(^XTMP("OR94","DUZ"))
if I
SET XMY(I)=""
+4 SET XMSUB="PATCH OR*3*94 POSTINIT COMPLETED"
+5 SET XMTEXT="ORZ("
DO ^XMD
+6 DO BMES^XPDUTL("The order dialogs for medications have been modified in this patch;")
+7 DO MES^XPDUTL("a bulletin has been sent to the installer listing local copies that")
+8 DO MES^XPDUTL("may need to be reviewed and updated.")
End DoDot:1
+9 QUIT
+10 ;
POST ; -- postinit for MOAB
+1 DO IVM
DO QO
+2 QUIT
+3 ;
IVM ; -- build S.IVM RX xref
+1 NEW ORNM,ORIT
+2 SET ORNM=""
FOR
SET ORNM=$ORDER(^ORD(101.43,"S.UD RX",ORNM))
if ORNM=""
QUIT
Begin DoDot:1
+3 SET ORIT=0
FOR
SET ORIT=+$ORDER(^ORD(101.43,"S.UD RX",ORNM,ORIT))
if ORIT'>0
QUIT
IF '$GET(^(ORIT))
IF $PIECE($GET(^ORD(101.43,ORIT,"PS")),U)=2
DO SET^ORDD43("IVM RX",ORIT)
End DoDot:1
+4 QUIT
+5 ;
FIRST() ; -- first install of this patch?
+1 ;set in pre-init if first install
NEW Y
SET Y=$GET(^XTMP("OR94","DUZ"))
+2 QUIT Y
+3 ;
QO ; -- check med QO's for inactive orderables, old OP doses
+1 ;
+2 ;conversion already run
if '$$FIRST
QUIT
+3 ;
+4 NEW ORODG,ORGRP,ORNOW,ORPOI,ORPDD,ORPIN,ORPFT,ORPST,ORPID,ORPAD,ORQDLG,OR0,ORDIALOG,ORIT,ORDRUG,ORPSOI,ORP,ORI,ORXX
+5 SET ORODG=+$ORDER(^ORD(100.98,"B","PHARMACY",0))
DO DG^ORCHANG1(ORODG,"BILD",.ORGRP)
+6 SET ORODG=+$ORDER(^ORD(100.98,"B","O RX",0))
SET ORNOW=$$NOW^XLFDT
+7 SET ORPOI=+$$PTR("ORDERABLE ITEM")
SET ORPDD=+$$PTR("DISPENSE DRUG")
+8 SET ORPIN=+$$PTR("INSTRUCTIONS")
SET ORPFT=+$$PTR("FREE TEXT")
+9 SET ORPST=+$$PTR("STRENGTH")
SET ORPID=+$$PTR("DOSE")
SET ORPAD=+$$PTR("ADDITIVE")
QO1 ;find where left off, if restarted
SET ORQDLG=+$GET(^XTMP("OR94","DLG"))
+1 FOR
SET ORQDLG=+$ORDER(^ORD(101.41,ORQDLG))
if ORQDLG'>0
QUIT
SET OR0=$GET(^(ORQDLG,0))
Begin DoDot:1
+2 ;pharmacy qo's only
if $PIECE(OR0,U,4)'="Q"
QUIT
if '$DATA(ORGRP(+$PIECE(OR0,U,5)))
QUIT
+3 KILL ORDIALOG,ORXX,^TMP("ORWORD",$JOB)
DO GETQDLG
if '$DATA(ORDIALOG)
QUIT
+4 SET ORDRUG=+$GET(ORDIALOG(ORPDD,1))
+5 ;
+6 ; -- Update inactive OI's, if possible
+7 FOR ORP=ORPOI,ORPAD
SET ORI=0
FOR
SET ORI=$ORDER(ORDIALOG(ORP,ORI))
if ORI'>0
QUIT
Begin DoDot:2
+8 NEW ORITM,ORPSITM,ORNEWOI
+9 SET ORITM=+$GET(ORDIALOG(ORP,ORI))
if ORITM'>0
QUIT
+10 ;still active
if '$GET(^ORD(101.43,ORITM,.1))!($GET(^(.1))>ORNOW)
QUIT
+11 SET ORPSITM=+$PIECE($GET(^ORD(101.43,ORITM,0)),U,2)
+12 SET ORNEWOI=$$EN^PSSQORD(ORPSITM,ORDRUG)
+13 IF ORNEWOI>0
IF $PIECE(ORNEWOI,U,2)!($PIECE(ORNEWOI,U,3)>ORNOW)
SET ORNEWOI=+$ORDER(^ORD(101.43,"ID",+ORNEWOI_";99PSP",0))
if ORNEWOI
SET ORDIALOG(ORP,ORI)=ORNEWOI
SET ORXX=1
QUIT
+14 ;list unconverted qo's for bulletin
SET ^XTMP("ORIT",ORQDLG)=""
End DoDot:2
+15 ;
QO2 ; -- Update Outpt instructions, if possible
+1 SET ORIT=+$GET(ORDIALOG(ORPOI,1))
SET ORPSOI=+$PIECE($GET(^ORD(101.43,ORIT,0)),U,2)
+2 IF $PIECE(OR0,U,5)=ORODG
Begin DoDot:2
+3 NEW ORDOSE,ORI,DRUG,STR
DO DOSE^PSSORUTL(.ORDOSE,ORPSOI,"O","")
+4 ;"" if no ORDRUG
SET DRUG=$GET(ORDOSE("DD",ORDRUG))
SET STR=$PIECE(DRUG,U,5,6)
+5 SET ORI=0
FOR
SET ORI=$ORDER(ORDIALOG(ORPIN,ORI))
if ORI'>0
QUIT
DO DOSE
+6 SET STR=$TRANSLATE(STR,"^")
IF STR
IF $PIECE($GET(^ORD(101.43,ORIT,0)),U)'[STR
SET ORDIALOG(ORPST,1)=STR
+7 ;set Drug Name if needed too?
End DoDot:2
+8 ;
+9 ; -- Save changes to quick order
+10 ;save responses if changed
IF $GET(ORXX)
DO SAVE^ORCMEDT0
+11 SET ^XTMP("OR94","DLG")=ORQDLG
End DoDot:1
+12 ;
QO3 ; -- Update inactive OI's in delayed orders, if possible
+1 DO QO3^ORY94A
+2 DO BULLETIN^ORY94A
+3 KILL ^TMP("ORWORD",$JOB),^TMP("ORTXT",$JOB),^XTMP("OR94")
+4 QUIT
+5 ;
PTR(X) ; -- Return ptr to prompt OR GTX X
+1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
+2 ;
GETQDLG ; -- Get quick order definition, build ORDIALOG()
+1 SET ORDIALOG=+$$DEFDLG^ORCD(ORQDLG)
if 'ORDIALOG
QUIT
+2 DO GETDLG^ORCD(ORDIALOG)
DO GETORDER^ORCD("^ORD(101.41,"_ORQDLG_",6)")
+3 ; -- set additional nodes for old Noun prompt
+4 NEW I,J,X
+5 SET I=0
FOR
SET I=$ORDER(^ORD(101.41,ORQDLG,6,"D",ORPFT,I))
if I'>0
QUIT
Begin DoDot:1
+6 SET J=+$PIECE($GET(^ORD(101.41,ORQDLG,6,I,0)),U,3)
SET X=$GET(^(1))
+7 if $DATA(ORDIALOG(ORPIN,J))
SET ORDIALOG(ORPFT,J)=X
End DoDot:1
+8 QUIT
+9 ;
DOSE ; -- Reformat outpt dose instance ORI, if possible/necessary
+1 ;already successfully converted
if $DATA(ORDIALOG(ORPID,ORI))
QUIT
+2 NEW UD,UNT,CONJ,IDX,DOSE,MATCH,X,Y
+3 SET UD=$GET(ORDIALOG(ORPIN,ORI))
SET UNT=$GET(ORDIALOG(ORPFT,ORI))
SET MATCH=0
+4 if UD="1/2"
SET UD=.5
if UD="1/3"
SET UD=.33
if UD="1/4"
SET UD=.25
if UD="3/4"
SET UD=.75
+5 ;strip trailing (s)
IF UNT?1.U1"(S)"
SET UNT=$PIECE(UNT,"(")_$SELECT(UD>1:"S",1:"")
+6 SET CONJ=$PIECE($GET(ORDOSE("MISC")),U,3)
if $LENGTH(CONJ)
SET CONJ=" "_CONJ
+7 SET IDX="ORDOSE(0)"
FOR
SET IDX=$QUERY(@IDX)
if IDX'?1"ORDOSE("1.N.",".N1")"
QUIT
Begin DoDot:1
+8 SET DOSE=@IDX
SET X=UD_$SELECT('$LENGTH(UNT):"",$PIECE(DOSE,U,3):"^"_UNT,1:" "_UNT)
+9 SET X=$$UP^XLFSTR(X)
IF ($PIECE(DOSE,U,3,4)=X)!($PIECE(DOSE,U,5)=X)
Begin DoDot:2
+10 ;not a match
IF ORDRUG
IF $PIECE(DOSE,U,6)'=ORDRUG
QUIT
+11 SET MATCH=MATCH+1
SET MATCH(MATCH)=$PIECE(DOSE,U,1,6)
End DoDot:2
End DoDot:1
D1 KILL ORDIALOG(ORPFT,ORI)
SET ORXX=1
+1 ;Update responses
IF MATCH=1
Begin DoDot:1
+2 SET Y=MATCH(1)
SET X=$PIECE(Y,U,5)
+3 if 'Y
SET X=X_CONJ_" "_$SELECT($GET(STR):$TRANSLATE(STR,"^"),1:$PIECE(DRUG,U))
+4 SET ORDIALOG(ORPIN,ORI)=X
+5 SET ORDIALOG(ORPDD,ORI)=$PIECE(Y,U,6)
+6 SET ORDIALOG(ORPID,ORI)=$TRANSLATE(Y,"^","&")_"&"_$TRANSLATE($GET(STR),"^","&")
End DoDot:1
QUIT
+7 ; -- Else save free text instructions, add qo to bulletin for review
+8 SET ORDIALOG(ORPIN,ORI)=UD_$SELECT($LENGTH(UNT):" "_UNT,1:"")
+9 ;K ORDIALOG(ORPDD,ORI) ;clear old dispense drug?
+10 SET ^XTMP("ORPSO",ORQDLG)=""
+11 QUIT
+12 ;
BULLETIN ; -- Send bulletin containing qo's we couldn't convert
+1 ;just in case
DO BULLETIN^ORY94A
+2 QUIT
+3 ;
DLGSEND(ANAME) ; -- Return true if the order dialog should be sent
+1 IF ANAME="OR GTX AND/THEN"
QUIT 1
+2 IF ANAME="OR GTX DAYS SUPPLY"
QUIT 1
+3 IF ANAME="OR GTX DOSE"
QUIT 1
+4 IF ANAME="OR GTX DRUG NAME"
QUIT 1
+5 IF ANAME="OR GTX INSTRUCTIONS"
QUIT 1
+6 IF ANAME="OR GTX NOW"
QUIT 1
+7 IF ANAME="OR GTX ORDERABLE ITEM"
QUIT 1
+8 IF ANAME="OR GTX PATIENT INSTRUCTIONS"
QUIT 1
+9 IF ANAME="OR GTX SIG"
QUIT 1
+10 IF ANAME="OR GTX STRENGTH"
QUIT 1
+11 IF ANAME="PS MEDS"
QUIT 1
+12 IF ANAME="PSJ OR PAT OE"
QUIT 1
+13 IF ANAME="PSO OERR"
QUIT 1
+14 IF ANAME="PSO SUPPLY"
QUIT 1
+15 QUIT 0
