| [613] | 1 | ORY299 ;SLC/JLC-Search for truncated Patient Instructions ;02/26/08 09:21
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**299**;Dec 17, 1997;Build 21
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN1 ;
|
|---|
| 6 | I $G(DUZ)="" W "Your DUZ is not defined.",! Q
|
|---|
| 7 | N ZTDESC,ZTIO,ZTRTN,ZTSK,ZTSAVE
|
|---|
| 8 | TASK S ZTRTN="EN^ORY299",ZTIO=""
|
|---|
| 9 | S ZTDESC="Check for Truncated Patient Instructions"
|
|---|
| 10 | D ^%ZTLOAD
|
|---|
| 11 | W !!,"The check for truncated Patient Instructions is",$S($D(ZTSK):"",1:" NOT")," queued",!
|
|---|
| 12 | I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | EN ; -- tasked entry point
|
|---|
| 16 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 17 | N CREAT,EXPR,OI,STOP,S1,X1,X2,X,OIEN,PSOP,A,S2,S3,B,DFN,PKGR,DIV,%,RXD,LASTS3,SET,UPD,IDFN,ORN,START
|
|---|
| 18 | D NOW^%DTC S CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0) K ^XTMP("ORY281A")
|
|---|
| 19 | S X1=%,X2=-366 D C^%DTC S S1=X
|
|---|
| 20 | ; .9.4 reference - DBIA # 2058
|
|---|
| 21 | ; PXRMINDX reference - DBIA # 4290
|
|---|
| 22 | ; PSRX reference - DBIA #5205
|
|---|
| 23 | S PSOP=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",""))
|
|---|
| 24 | S OI=0 F S OI=$O(^PXRMINDX(52,"IP",OI)) Q:'OI D
|
|---|
| 25 | . S IDFN=0 F S IDFN=$O(^PXRMINDX(52,"IP",OI,IDFN)) Q:'IDFN D
|
|---|
| 26 | .. S START=0 F S START=$O(^PXRMINDX(52,"IP",OI,IDFN,START)) Q:'START D
|
|---|
| 27 | ... S STOP=S1 F S STOP=$O(^PXRMINDX(52,"IP",OI,IDFN,START,STOP)) Q:'STOP D
|
|---|
| 28 | .... S ORN=0 F S ORN=$O(^PXRMINDX(52,"IP",OI,IDFN,START,STOP,ORN)) Q:'ORN S OIEN=$P(^PSRX(+ORN,"OR1"),"^",2),UPD=0 I OIEN]"" D
|
|---|
| 29 | ..... S A=$G(^OR(100,OIEN,0)) Q:$P(A,"^",14)'=PSOP
|
|---|
| 30 | ..... S S2=$O(^OR(100,OIEN,4.5,"ID","PI","")) Q:S2=""
|
|---|
| 31 | ..... S DFN=$P($P(A,"^",2),";"),PKGR=$G(^OR(100,OIEN,4)) Q:PKGR="" D EN^PSOORDER(DFN,PKGR) Q:'$D(^TMP("PSOR",$J))
|
|---|
| 32 | ..... S DIV=$P(^TMP("PSOR",$J,PKGR,1),"^",7),S3=0 F B=1:1 Q:'$D(^TMP("PSOR",$J,PKGR,"PI",B,0)) S RXD=^(0),S3=$O(^OR(100,OIEN,4.5,S2,2,S3)) D Q:UPD
|
|---|
| 33 | ...... I S3]"" S LASTS3=S3
|
|---|
| 34 | ...... I S3="" D UPDATE S UPD=1 Q
|
|---|
| 35 | ...... I $G(^OR(100,OIEN,4.5,S2,2,S3,0))'=$G(^TMP("PSOR",$J,PKGR,"PI",B,0)) D UPDATE S UPD=1
|
|---|
| 36 | I $D(^XTMP("ORY281A")) S ^XTMP("ORY281A",0)=EXPR_"^"_CREAT
|
|---|
| 37 | D SEND
|
|---|
| 38 | K ZTQUEUED,ZTREQ Q
|
|---|
| 39 | UPDATE ;Update OR file and record problem order number
|
|---|
| 40 | S ^XTMP("ORY281A",DIV,OIEN)=$P(^TMP("PSOR",$J,PKGR,0),"^",5)_"^"_$P($P(^TMP("PSOR",$J,PKGR,"DRUG",0),"^"),";",2)
|
|---|
| 41 | S A=$G(^OR(100,OIEN,4.5,S2,2,0)) K ^OR(100,OIEN,4.5,S2,2)
|
|---|
| 42 | M ^OR(100,OIEN,4.5,S2,2)=^TMP("PSOR",$J,PKGR,"PI")
|
|---|
| 43 | S SET=$O(^OR(100,OIEN,4.5,S2,2,""),-1),$P(A,"^",3)=SET,$P(A,"^",4)=SET,^OR(100,OIEN,4.5,S2,2,0)=A
|
|---|
| 44 | Q
|
|---|
| 45 | SEND ;Send message
|
|---|
| 46 | K ORMSG,XMY N OCNT,OIEN,A,XMDUZ,XMSUB,XMTEXT,OIP,DIV,SP,DVNM,STATUS,STOP,OI,RX,DD
|
|---|
| 47 | S XMDUZ="CPRS, SEARCH",XMSUB="TRUNCATED PATIENT INSTRUCTIONS",XMTEXT="ORMSG(",XMY(DUZ)=""
|
|---|
| 48 | S ORMSG(1,0)=" The check for truncated Patient Instructions is complete."
|
|---|
| 49 | S ORMSG(2,0)=" ",ORMSG(3,0)=" Here is the list of the affected orders: ",ORMSG(4,0)=" "
|
|---|
| 50 | S (DIV,OIEN)=0,ORMSG(5,0)="Patient/Division SSN Item/Dispense Status/RX# Stop/OIEN",OCNT=5,SP=$J(" ",50)
|
|---|
| 51 | I '$D(^XTMP("ORY281A")) S OCNT=OCNT+1,ORMSG(OCNT,0)="No orders found."
|
|---|
| 52 | F S DIV=$O(^XTMP("ORY281A",DIV)) Q:DIV="" D PSS^PSO59(DIV,,"ORY281A") S DVNM=^TMP($J,"ORY281A",DIV,.01) D
|
|---|
| 53 | . F S OIEN=$O(^XTMP("ORY281A",DIV,OIEN)) Q:OIEN="" S A=^(OIEN),RX=$P(A,"^"),DD=$P(A,"^",2) D
|
|---|
| 54 | .. S A=$G(^OR(100,OIEN,0)),DFN=$P($P(A,"^",2),";"),STOP=$P(A,"^",9),STOP=$E(STOP,4,5)_"/"_$E(STOP,6,7)_"/"_($E(STOP,1,3)+1700)_" "_$E(STOP,9,10)
|
|---|
| 55 | .. S A=^DPT(DFN,0),STATUS=$P($G(^OR(100,OIEN,3)),"^",3),STATUS=$P($G(^ORD(100.01,STATUS,0)),"^")
|
|---|
| 56 | .. S OIP=$O(^OR(100,OIEN,4.5,"ID","ORDERABLE","")),OI=$G(^OR(100,OIEN,4.5,OIP,1)),OI=$P($G(^ORD(101.43,OI,0)),"^")
|
|---|
| 57 | .. S OCNT=OCNT+1,ORMSG(OCNT,0)=$E($P(A,"^")_SP,1,20)_" "_$E($P(A,"^",9),6,9)_" "_$E(OI_SP,1,20)_" "_$E(STATUS_SP,1,13)_" "_STOP
|
|---|
| 58 | .. S OCNT=OCNT+1,ORMSG(OCNT,0)=$E(DVNM_SP,1,26)_" "_$E(DD_SP,1,20)_" "_$E(RX_SP,1,13)_" "_OIEN
|
|---|
| 59 | .. S OCNT=OCNT+1,ORMSG(OCNT,0)=" "
|
|---|
| 60 | D ^XMD
|
|---|
| 61 | Q
|
|---|
