source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDWCHG.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1PSDWCHG ;BIR/JPW-CS Mass Ward (for Drug) Transfer ; 6 July 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3 I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
4 S PSDUZ=DUZ
5 W !!,"This routine will allow you to do a mass conversion of all drugs in an ",!,"active NAOU from an old Ward designation to a new Ward designation."
6 W !!,"You may convert a single NAOU, several NAOUs, or enter ^ALL to convert",!,"all NAOUs.",!!
7NAOU ;ask NAOU
8 K DA,DIC
9 F S DIC=58.8,DIC("A")="Select NAOU: ",DIC(0)="QEA",DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,^(""I"")>DT:1,1:0),$P(^(0),""^"",2)=""N"",$P(^(0),""^"",3)=+PSDSITE" D ^DIC K DIC Q:Y<0 S NAOU(+Y)=""
10 I '$D(NAOU)&(X'="^ALL") G END
11 I X="^ALL" F PSD=0:0 S PSD=$O(^PSD(58.8,PSD)) Q:'PSD I $S('$D(^PSD(58.8,PSD,"I")):1,'^("I"):1,^("I")>DT:1,1:0),$P($G(^(0)),"^",2)="N",$P($G(^(0)),"^",3)=+PSDSITE S NAOU(PSD)=""
12 G:'$D(NAOU) END
13OLD ;asking for old (current) WARD (FOR DRUG)
14 K DA,DIR,DIRUT S DIR(0)="PO^42:EM",DIR("A")="Select OLD WARD",DIR("?")="Enter the Ward that currently exists in the WARD (FOR DRUG) field." D ^DIR K DIR I (Y<0)!$D(DIRUT) G END
15 S OLD=+Y,OLDN=$P(Y,"^",2)
16NEW ;asking new (replacement) WARD (FOR DRUG)
17 K DA,DIR,DIRUT S DIR(0)="PO^42:EM",DIR("A")="Select NEW WARD",DIR("?")="Enter the new Ward you wish to replace "_OLDN D ^DIR K DIR I $D(DIRUT)!(Y<0) W !,"No Action Taken",! G END
18 S NEW=+Y,NEWN=$P(Y,"^",2)
19QUE ;asks queueing information
20 S QUE=0 W !! K DA,DIR,DIRUT S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to queue this job",DIR("?",1)="To queue this job to run at a later time and free up your terminal now,"
21 S DIR("?")="accept the default, enter 'N' to run immediately or '^' to quit." D ^DIR K DIR I $D(DIRUT) W $C(7),!!,"The WARD change you selected will not be updated.",!! G END
22 I 'Y W !!,"Converting WARD (for Drug) now..." G START
23 S QUE=1 W !!,"You will be notified by MailMan when the job is completed.",!!
24 S ZTIO="",ZTRTN="START^PSDWCHG",ZTDESC="CS MASS WARD CONVERSION" S (ZTSAVE("OLD"),ZTSAVE("OLDN"),ZTSAVE("NEW"),ZTSAVE("NEWN"),ZTSAVE("QUE"),ZTSAVE("PSDUZ"))="" S:$D(NAOU) ZTSAVE("NAOU(")="" D ^%ZTLOAD K ZTSK G END
25START ;loop to update ward conversion
26 K ^TMP("PSDWCHG",$J) S (CNTN,CNTD)=0
27 F PSDRG=0:0 S PSDRG=$O(^PSD(58.8,"D",PSDRG)) Q:'PSDRG F LOC=0:0 S LOC=$O(^PSD(58.8,"D",PSDRG,OLD,LOC)) Q:'LOC I $D(NAOU(LOC)),$P($G(^PSD(58.8,LOC,0)),"^",2)'="P",$D(^PSD(58.8,LOC,1,PSDRG,0)) S ^TMP("PSDWCHG",$J,LOC,PSDRG)=""
28 I $D(^TMP("PSDWCHG",$J)) F LOC=0:0 S LOC=$O(^TMP("PSDWCHG",$J,LOC)) Q:'LOC S CNTN=CNTN+1 F PSDRG=0:0 S PSDRG=$O(^TMP("PSDWCHG",$J,LOC,PSDRG)) Q:'PSDRG S CNTD=CNTD+1 D CHG
29 K ^TMP("PSDWCHG",$J) D:QUE MSG
30 I 'QUE W $C(7),!!,"Total Stock Drugs converted: ",CNTD,!,"Total NAOU(s) converted: ",CNTN,!
31END K %,%H,%I,CNTD,CNTN,DA,DIC,DIE,DIR,DIR,DIRUT,DR,DTOUT,DUOUT,JJ,LOC,NAOU,NEW,NEWN,OLD,OLDN
32 K PSD,PSDA,PSDOUT,PSDR,PSDRG,PSDUZ,QUE,RDT,SUB,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("PSDWCHG",$J)
33 S:$D(ZTQUEUED) ZTREQ="@"
34 Q
35CHG ;change wards
36 K DA,DIK S DA(2)=LOC,DA(1)=PSDRG,DA=OLD,DIK="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",1," D ^DIK K DIK
37 I '$D(^PSD(58.8,LOC,1,PSDRG,1,NEW,0)) K DA S DA(2)=LOC,DA(1)=PSDRG,DA=NEW,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",1,",DR=".01////"_NEW D ^DIE K DIE W:'QUE "."
38 S SUB=0 F JJ=0:0 S JJ=$O(^PSD(58.8,LOC,1,PSDRG,1,JJ)) Q:'JJ S SUB=SUB+1
39 S $P(^PSD(58.8,LOC,1,PSDRG,1,0),"^",3,4)=NEW_"^"_SUB
40 Q
41MSG ;send mailman message with completed info
42 K XMY,^TMP("PSDWCMSG",$J) D NOW^%DTC S Y=X X ^DD("DD") S RDT=Y S ^TMP("PSDWCMSG",$J,1,0)="CS PHARM Conversion background job has run to completion.",^TMP("PSDWCMSG",$J,2,0)="Run Date: "_RDT,^TMP("PSDWCMSG",$J,3,0)=""
43 S ^TMP("PSDWCMSG",$J,4,0)="Old Ward: "_OLDN_" converted to New Ward: "_NEWN,^TMP("PSDWCMSG",$J,5,0)="Total number of NAOU(s) converted: "_CNTN
44 S ^TMP("PSDWCMSG",$J,6,0)="Total number of Stock Drugs converted: "_CNTD
45 S XMSUB="CS PHARM MASS WARD CONVERSION SUMMARY",XMTEXT="^TMP(""PSDWCMSG"",$J,",XMDUZ="CONTROLLED SUBSTANCES PHARMACY",XMY(PSDUZ)="" S:'$D(XMY) XMY(.5)="" D ^XMD K XMY,^TMP("PSDWCMSG",$J)
46 Q
Note: See TracBrowser for help on using the repository browser.