Routine: ORY134

ORY134 ;SLC/DAN ;3/28/02  12:35

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**134**;Dec 17, 1997

 ;Finds current orders with incorrect fractional dose entries containing two decimal places.

 N ORMSG,ZTSK

 S ORMSG(1)=""

 S ORMSG(2)="This patch contains a post-init.  This post-init will"

 S ORMSG(3)="run in the background and will identify potential fractional dose problems."

 S ORMSG(4)="It will then send a mail message to the iniator and holders of the PSNMGR key"

 S ORMSG(5)="indicating which orders need to be reviewed."

 S ORMSG(6)=""

 D MES^XPDUTL(.ORMSG)

 S ZTRTN="DQ^ORY134",ZTDESC="Patch OR*3*134 database review",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=$H

 D ^%ZTLOAD

 I $G(ZTSK) D MES^XPDUTL("Post-init queued to background as task number "_ZTSK_".")

DQ ;Enter here for queued task

 K ^TMP("ORFIX",$J)

 D FIX,MAIL

 K ^TMP("ORFIX",$J),^TMP("ORTXT",$J)

FIX ;This section will identify active orders with fractional dose problems

 N PAT,DATE,IEN,PTID

 S PAT=""

 F  S PAT=$O(^OR(100,"AC",PAT)) Q:PAT=""  D

 .S DATE=0 F  S DATE=$O(^OR(100,"AC",PAT,DATE)) Q:'+DATE  D

 ..S IEN=0 F  S IEN=$O(^OR(100,"AC",PAT,DATE,IEN)) Q:'+IEN  D

 ...Q:$$NMSP^ORCD($P($G(^OR(100,IEN,0)),U,14))'="PS"  ;quit if not pharmacy

 ...S PTID=$$PTID(PAT) Q:PTID=-1  ;get patient ID quit if referral or couldn't determine name

 ...I $$VALUE^ORX8(IEN,"INSTR")["0.." I '$$UPDT S ^TMP("ORFIX",$J,$P($$STATUS^ORQOR2(IEN),U,2),PTID,IEN)=$$DRUG

MAIL ;Send results of review in a mail message to initiator

 N I,XMSUB,XMTEXT,XMDUZ,XMY,STA,IEN,PAT

 S XMSUB="Patch OR*3*134 review completed"

 S XMDUZ="Patch OR*3*134 Post-Init"

 S XMY(.5)="" S:$G(DUZ) XMY(DUZ)="" D PSNMGR(.XMY)

 S XMTEXT="^TMP(""ORTXT"",$J,"

 K ^TMP("ORTXT",$J)

 S I=1

 S ^TMP("ORTXT",$J,I)="The database review for patch OR*3*134 has completed.",I=I+1

 S ^TMP("ORTXT",$J,I)="Below is a listing of patients that need to have",I=I+1

 S ^TMP("ORTXT",$J,I)="their prescriptions reviewed and possibly updated.",I=I+1

 S ^TMP("ORTXT",$J,I)="",I=I+1

 S ^TMP("ORTXT",$J,I)="For orders in an active (active, pending, hold, etc) state it is",I=I+1

 S ^TMP("ORTXT",$J,I)="recommended that the order be evaluated and updated according to",I=I+1

 S ^TMP("ORTXT",$J,I)="the following guidelines.",I=I+1

 S ^TMP("ORTXT",$J,I)="",I=I+1

 S ^TMP("ORTXT",$J,I)="If the order has refills remaining or if the order can",I=I+1

 S ^TMP("ORTXT",$J,I)="potentially be renewed, edit the invalid dosage which will",I=I+1

 S ^TMP("ORTXT",$J,I)="create a new order with a valid SIG.  The appropriate number",I=I+1

 S ^TMP("ORTXT",$J,I)="of remaining refills must then be added to the new order.",I=I+1

 S ^TMP("ORTXT",$J,I)="",I=I+1

 S ^TMP("ORTXT",$J,I)="If the order has no refills remaining and the order will not",I=I+1

 S ^TMP("ORTXT",$J,I)="be renewed then the order should be discontinued.",I=I+1

 S ^TMP("ORTXT",$J,I)="",I=I+1

 S ^TMP("ORTXT",$J,I)="Depending on the status of the order the DRUG listed in the report",I=I+1

 S ^TMP("ORTXT",$J,I)="will either be a dispense drug or an orderable item.",I=I+1

 S ^TMP("ORTXT",$J,I)="",I=I+1

 I '$D(^TMP("ORFIX",$J)) S ^TMP("ORTXT",$J,I)="No problems were found.  No manual intervention is required.",I=I+1

 S ^TMP("ORTXT",$J,I)="",I=I+1

 S STA="" F  S STA=$O(^TMP("ORFIX",$J,STA)) Q:STA=""  D

 .S ^TMP("ORTXT",$J,I)="Order Status - "_STA,I=I+1,^TMP("ORTXT",$J,I)="",I=I+1

 .S PAT=0 F  S PAT=$O(^TMP("ORFIX",$J,STA,PAT)) Q:PAT=""  D

 ..S IEN=0 F  S IEN=$O(^TMP("ORFIX",$J,STA,PAT,IEN)) Q:'+IEN  D

 ...S ^TMP("ORTXT",$J,I)=PAT_$$REPEAT^XLFSTR(" ",(40-$L(PAT)))_"DRUG = "_^TMP("ORFIX",$J,STA,PAT,IEN),I=I+1

 .S ^TMP("ORTXT",$J,I)="",I=I+1

 D ^XMD ;send results

PTID(IEN) ;Return pt name and 1A4U identifiers or -1 if unable to determine

 N DFN,VADM

 I +IEN=0!(IEN'["DPT") Q -1

 S DFN=+IEN

 D ^VADPT

 I $G(VADM(1))="" Q -1

 Q $E(VADM(1),1)_$E(VADM(2),6,9)_"  "_VADM(1)

UPDT() ;Function to determine if order has been updated yet.

 N TXT,I,UPDT

 S UPDT=1

 D TEXT^ORQ12(.TXT,IEN_";"_$P($G(^OR(100,IEN,3)),U,7),80) ;get current order text

 F I=1:1:TXT I TXT(I)["0.." S UPDT=0 Q

 Q UPDT

DRUG() ;Get dispense drug or orderable item

 N VALUE

 S VALUE=$$VALUE^ORX8(IEN,"DRUG",,"E")

 I VALUE="" S VALUE=$$VALUE^ORX8(IEN,"ORDERABLE",,"E")

 Q VALUE

PSNMGR(XMY) ;Add PSNMGR key holders to XMY array

 ;DBIA 10076 allows direct read of XUSEC

 N USER

 S USER=0 F  S USER=$O(^XUSEC("PSNMGR",USER)) Q:'USER  S XMY(USER)=""

ORY134    ;SLC/DAN ;3/28/02  12:35

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**134**;Dec 17, 1997

 +2       ;

 +3       ;Finds current orders with incorrect fractional dose entries containing two decimal places.

 +4       ;

 +5        NEW ORMSG,ZTSK

 +6        SET ORMSG(1)=""

 +7        SET ORMSG(2)="This patch contains a post-init.  This post-init will"

 +8        SET ORMSG(3)="run in the background and will identify potential fractional dose problems."

 +9        SET ORMSG(4)="It will then send a mail message to the iniator and holders of the PSNMGR key"

 +10       SET ORMSG(5)="indicating which orders need to be reviewed."

 +11       SET ORMSG(6)=""

 +12       DO MES^XPDUTL(.ORMSG)

 +13       SET ZTRTN="DQ^ORY134"

           SET ZTDESC="Patch OR*3*134 database review"

           SET ZTIO=""

           SET ZTSAVE("DUZ")=""

           SET ZTDTH=$HOROLOG

 +14       DO ^%ZTLOAD

 +15       IF $GET(ZTSK)

               DO MES^XPDUTL("Post-init queued to background as task number "_ZTSK_".")

 +16       QUIT

 +17      ;

DQ        ;Enter here for queued task

 +1        KILL ^TMP("ORFIX",$JOB)

 +2        DO FIX

           DO MAIL

 +3        KILL ^TMP("ORFIX",$JOB),^TMP("ORTXT",$JOB)

 +4        QUIT

 +5       ;

FIX       ;This section will identify active orders with fractional dose problems

 +1        NEW PAT,DATE,IEN,PTID

 +2        SET PAT=""

 +3        FOR

               SET PAT=$ORDER(^OR(100,"AC",PAT))

               IF PAT=""

                   QUIT

               Begin DoDot:1

 +4                SET DATE=0

FOR

                       SET DATE=$ORDER(^OR(100,"AC",PAT,DATE))

                       IF '+DATE

                           QUIT

                       Begin DoDot:2

 +5                        SET IEN=0

FOR

                               SET IEN=$ORDER(^OR(100,"AC",PAT,DATE,IEN))

                               IF '+IEN

                                   QUIT

                               Begin DoDot:3

 +6       ;quit if not pharmacy

                                   IF $$NMSP^ORCD($PIECE($GET(^OR(100,IEN,0)),U,14))'="PS"

                                       QUIT

 +7       ;get patient ID quit if referral or couldn't determine name

                                   SET PTID=$$PTID(PAT)

                                   IF PTID=-1

                                       QUIT

 +8                                IF $$VALUE^ORX8(IEN,"INSTR")["0.."

                                       IF '$$UPDT

                                           SET ^TMP("ORFIX",$JOB,$PIECE($$STATUS^ORQOR2(IEN),U,2),PTID,IEN)=$$DRUG

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +9        QUIT

 +10      ;

MAIL      ;Send results of review in a mail message to initiator

 +1        NEW I,XMSUB,XMTEXT,XMDUZ,XMY,STA,IEN,PAT

 +2        SET XMSUB="Patch OR*3*134 review completed"

 +3        SET XMDUZ="Patch OR*3*134 Post-Init"

 +4        SET XMY(.5)=""

           IF $GET(DUZ)

               SET XMY(DUZ)=""

           DO PSNMGR(.XMY)

 +5        SET XMTEXT="^TMP(""ORTXT"",$J,"

 +6        KILL ^TMP("ORTXT",$JOB)

 +7        SET I=1

 +8        SET ^TMP("ORTXT",$JOB,I)="The database review for patch OR*3*134 has completed."

           SET I=I+1

 +9        SET ^TMP("ORTXT",$JOB,I)="Below is a listing of patients that need to have"

           SET I=I+1

 +10       SET ^TMP("ORTXT",$JOB,I)="their prescriptions reviewed and possibly updated."

           SET I=I+1

 +11       SET ^TMP("ORTXT",$JOB,I)=""

           SET I=I+1

 +12       SET ^TMP("ORTXT",$JOB,I)="For orders in an active (active, pending, hold, etc) state it is"

           SET I=I+1

 +13       SET ^TMP("ORTXT",$JOB,I)="recommended that the order be evaluated and updated according to"

           SET I=I+1

 +14       SET ^TMP("ORTXT",$JOB,I)="the following guidelines."

           SET I=I+1

 +15       SET ^TMP("ORTXT",$JOB,I)=""

           SET I=I+1

 +16       SET ^TMP("ORTXT",$JOB,I)="If the order has refills remaining or if the order can"

           SET I=I+1

 +17       SET ^TMP("ORTXT",$JOB,I)="potentially be renewed, edit the invalid dosage which will"

           SET I=I+1

 +18       SET ^TMP("ORTXT",$JOB,I)="create a new order with a valid SIG.  The appropriate number"

           SET I=I+1

 +19       SET ^TMP("ORTXT",$JOB,I)="of remaining refills must then be added to the new order."

           SET I=I+1

 +20       SET ^TMP("ORTXT",$JOB,I)=""

           SET I=I+1

 +21       SET ^TMP("ORTXT",$JOB,I)="If the order has no refills remaining and the order will not"

           SET I=I+1

 +22       SET ^TMP("ORTXT",$JOB,I)="be renewed then the order should be discontinued."

           SET I=I+1

 +23       SET ^TMP("ORTXT",$JOB,I)=""

           SET I=I+1

 +24       SET ^TMP("ORTXT",$JOB,I)="Depending on the status of the order the DRUG listed in the report"

           SET I=I+1

 +25       SET ^TMP("ORTXT",$JOB,I)="will either be a dispense drug or an orderable item."

           SET I=I+1

 +26       SET ^TMP("ORTXT",$JOB,I)=""

           SET I=I+1

 +27       IF '$DATA(^TMP("ORFIX",$JOB))

               SET ^TMP("ORTXT",$JOB,I)="No problems were found.  No manual intervention is required."

               SET I=I+1

 +28       SET ^TMP("ORTXT",$JOB,I)=""

           SET I=I+1

 +29       SET STA=""

FOR

               SET STA=$ORDER(^TMP("ORFIX",$JOB,STA))

               IF STA=""

                   QUIT

               Begin DoDot:1

 +30               SET ^TMP("ORTXT",$JOB,I)="Order Status - "_STA

                   SET I=I+1

                   SET ^TMP("ORTXT",$JOB,I)=""

                   SET I=I+1

 +31               SET PAT=0

FOR

                       SET PAT=$ORDER(^TMP("ORFIX",$JOB,STA,PAT))

                       IF PAT=""

                           QUIT

                       Begin DoDot:2

 +32                       SET IEN=0

FOR

                               SET IEN=$ORDER(^TMP("ORFIX",$JOB,STA,PAT,IEN))

                               IF '+IEN

                                   QUIT

                               Begin DoDot:3

 +33                               SET ^TMP("ORTXT",$JOB,I)=PAT_$$REPEAT^XLFSTR(" ",(40-$LENGTH(PAT)))_"DRUG = "_^TMP("ORFIX",$JOB,STA,PAT,IEN)

                                   SET I=I+1

                               End DoDot:3

                       End DoDot:2

 +34               SET ^TMP("ORTXT",$JOB,I)=""

                   SET I=I+1

               End DoDot:1

 +35      ;send results

           DO ^XMD

 +36       QUIT

 +37      ;

PTID(IEN) ;Return pt name and 1A4U identifiers or -1 if unable to determine

 +1        NEW DFN,VADM

 +2        IF +IEN=0!(IEN'["DPT")

               QUIT -1

 +3        SET DFN=+IEN

 +4        DO ^VADPT

 +5        IF $GET(VADM(1))=""

               QUIT -1

 +6        QUIT $EXTRACT(VADM(1),1)_$EXTRACT(VADM(2),6,9)_"  "_VADM(1)

 +7       ;

UPDT()    ;Function to determine if order has been updated yet.

 +1        NEW TXT,I,UPDT

 +2        SET UPDT=1

 +3       ;get current order text

           DO TEXT^ORQ12(.TXT,IEN_";"_$PIECE($GET(^OR(100,IEN,3)),U,7),80)

 +4        FOR I=1:1:TXT

               IF TXT(I)["0.."

                   SET UPDT=0

                   QUIT

 +5        QUIT UPDT

 +6       ;

DRUG()    ;Get dispense drug or orderable item

 +1        NEW VALUE

 +2        SET VALUE=$$VALUE^ORX8(IEN,"DRUG",,"E")

 +3        IF VALUE=""

               SET VALUE=$$VALUE^ORX8(IEN,"ORDERABLE",,"E")

 +4        QUIT VALUE

 +5       ;

PSNMGR(XMY) ;Add PSNMGR key holders to XMY array

 +1       ;DBIA 10076 allows direct read of XUSEC

 +2        NEW USER

 +3        SET USER=0

FOR

               SET USER=$ORDER(^XUSEC("PSNMGR",USER))

               IF 'USER

                   QUIT

               SET XMY(USER)=""

 +4        QUIT

ORY134.m