| 1 | PSJ0099 ;BIR/JLC - EVALUATE IV ORDER PROBLEMS ;12/03/2002
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**99**;16 DE7 97
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^PS(55 supported by DBIA 2191
|
|---|
| 5 | ;
|
|---|
| 6 | ENNV ; Begin check of existing orders
|
|---|
| 7 | I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined to run this routine." Q
|
|---|
| 8 | K ZTSAVE,ZTSK S ZTRTN="START^PSJ0099",ZTDESC="Inpatient Orders Check (INPATIENT MEDS)",ZTIO="" D ^%ZTLOAD
|
|---|
| 9 | W !!,"The check of existing Pharmacy orders is",$S($D(ZTSK):"",1:" NOT")," queued",!
|
|---|
| 10 | I $D(ZTSK) D
|
|---|
| 11 | . W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
|
|---|
| 12 | Q
|
|---|
| 13 | START ;run through entries in XTMP("PSOPOST7"
|
|---|
| 14 | S JOB=0 I $D(^XTMP("PSOPOST7")) S $P(^("PSOPOST7",0),"^",1)="3030531"
|
|---|
| 15 | F S JOB=$O(^XTMP("PSOPOST7",JOB)) Q:JOB="" D
|
|---|
| 16 | . S DFN=""
|
|---|
| 17 | . F S DFN=$O(^XTMP("PSOPOST7",JOB,"IV",DFN)) Q:DFN="" D
|
|---|
| 18 | .. S PSJORD=""
|
|---|
| 19 | .. F S PSJORD=$O(^XTMP("PSOPOST7",JOB,"IV",DFN,PSJORD)) Q:PSJORD="" D
|
|---|
| 20 | ... W !! S S1="^PS(55,"_DFN_",""IV"","_PSJORD_")",CHK=$P(S1,")")
|
|---|
| 21 | ... F S S1=$Q(@S1) Q:S1="" Q:$P(S1,",",1,4)'=CHK W S1," = ",@S1,!
|
|---|
| 22 | ... S A=$G(^PS(55,DFN,"IV",PSJORD,0)) I A="" S ^XTMP("PSJ0099",$J,DFN,PSJORD)="NOT ON FILE" Q
|
|---|
| 23 | ... S PSSTART=$P(A,"^",2),PSSTOP=$P(A,"^",3),PSSTATUS=$P(A,"^",17)
|
|---|
| 24 | ... I PSSTATUS'["S X=" S ^XTMP("PSJ0099",$J,DFN,PSJORD)="STATUS" D Q
|
|---|
| 25 | .... I '$D(^PS(55,DFN,"IV",PSJORD,2)) K ^XTMP("PSJ0099",$J,DFN,PSJORD) Q
|
|---|
| 26 | ... S ^XTMP("PSJ0099",$J,DFN,PSJORD)="OTHER" D NOSTOP
|
|---|
| 27 | D NOW^%DTC S PSJSTART=$E(%,1,12),CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,90,0,0,0)
|
|---|
| 28 | I $D(^XTMP("PSJ0099",$J)) S ^($J,0)=EXPR_"^"_CREAT
|
|---|
| 29 | SENDMSG ;Send mail message when check is complete.
|
|---|
| 30 | K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="INPATIENT MEDS ORDER CHECK COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
|
|---|
| 31 | S PSG(1,0)="The check of existing Pharmacy orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
|
|---|
| 32 | I $D(^XTMP("PSOPOST7")) D
|
|---|
| 33 | . S PSG(3,0)="There were Pharmacy orders - listed in ^XTMP(""PSOPOST7"",,""IV""",PSG(4,0)="that had changes made."
|
|---|
| 34 | . S PSG(5,0)="Please spot check some of the affected orders to be sure",PSG(6,0)="they are now correct."
|
|---|
| 35 | . I $D(^XTMP("PSJ0099")) S PSG(7,0)="Some orders could not be changed. These are listed in XTMP(""PSJ0099"".",PSG(8,0)="Please check these patients to be sure their profile is correct."
|
|---|
| 36 | D ^XMD
|
|---|
| 37 | Q
|
|---|
| 38 | NOSTOP S D2=0,OLD=""
|
|---|
| 39 | F S D2=$O(^PS(55,DFN,"IV",PSJORD,"A",D2)) Q:'D2 D
|
|---|
| 40 | . S D3=0
|
|---|
| 41 | . F S D3=$O(^PS(55,DFN,"IV",PSJORD,"A",D2,1,D3)) Q:'D3 D
|
|---|
| 42 | .. S ACTDATA=^PS(55,DFN,"IV",PSJORD,"A",D2,1,D3,0)
|
|---|
| 43 | .. Q:$P(ACTDATA,"^")'="STATUS" S A=$P(ACTDATA,"^",2)
|
|---|
| 44 | .. I A'="DISCONTINUED",A'="EXPIRED",A'="PURGE",A'="ON CALL",A'="NON VERIFIED" Q
|
|---|
| 45 | .. S OLD=A
|
|---|
| 46 | I OLD="",PSSTOP=1 S OLD="PURGE"
|
|---|
| 47 | S STATUS=$S(OLD="DISCONTINUED":"D",OLD="EXPIRED":"E",OLD="PURGE":"P",OLD="ON CALL":"OC",OLD="NON VERIFIED":"N",1:"")
|
|---|
| 48 | K DR S DIE="^PS(55,"_DFN_",""IV"",",DA=PSJORD,DA(1)=DFN,DR="100////"_STATUS D ^DIE
|
|---|
| 49 | I STATUS="" S $P(^PS(55,DFN,"IV",PSJORD,0),"^",17)=""
|
|---|
| 50 | K ^XTMP("PSJ0099",$J,DFN,PSJORD) Q
|
|---|
