Routine: ORY94

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")

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

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

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.")

POST ; -- postinit for MOAB

 D IVM,QO

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)

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")

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

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)=""

BULLETIN ; -- Send bulletin containing qo's we couldn't convert

 D BULLETIN^ORY94A ;just in case

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

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

ORY94.m