source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJ0099.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1PSJ0099 ;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 ;
6ENNV ; 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
13START ;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
29SENDMSG ;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
38NOSTOP 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
Note: See TracBrowser for help on using the repository browser.