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_".")
Q
;
DQ ;Enter here for queued task
K ^TMP("ORFIX",$J)
D FIX,MAIL
K ^TMP("ORFIX",$J),^TMP("ORTXT",$J)
Q
;
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
Q
;
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
Q
;
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)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY134 4494 printed Nov 22, 2024@17:48:24 Page 2
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
