| 1 | PSGWCHG ;BHAM ISC/CML-AR/WS Mass Ward Conversion ; 06 Aug 93 / 2:18 PM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | W !!,"This routine will allow you to do a mass conversion of all active items in",!,"an active AOU from an old Ward designation to a new Ward designation."
|
|---|
| 4 | D SEL^PSGWUTL1 G:'$D(SEL) QUIT I SEL="I" F JJ=0:0 S JJ=$O(AOULP(JJ)) Q:'JJ I $S('$D(^PSI(58.1,JJ,"I")):0,'^("I"):0,^("I")>DT:0,1:1) K AOULP(JJ)
|
|---|
| 5 | G:SEL="I" ASK
|
|---|
| 6 | F QQ=0:0 S DIC="^PSI(58.1,",DIC(0)="QEAM",DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,^(""I"")>DT:1,1:0)" D ^DIC K DIC Q:Y<0 S AOULP(+Y)=""
|
|---|
| 7 | I '$D(AOULP)&(X'="^ALL") G QUIT
|
|---|
| 8 | I X="^ALL" F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU I $S('$D(^PSI(58.1,AOU,"I")):1,'^("I"):1,^("I")>DT:1,1:0) S AOULP(AOU)=""
|
|---|
| 9 | ASK G:'$D(AOULP) QUIT
|
|---|
| 10 | OLD R !!,"Select OLD WARD: ",X:DTIME S:'$T X="^" G:"^"[X QUIT W:X?1."?" !!,"Enter the Ward that currently exists in the WARD (FOR ITEM) field.",! S DIC="^DIC(42,",DIC(0)="QEM" D ^DIC K DIC G:Y<0 OLD S OLD=+Y
|
|---|
| 11 | NEW R !!,"Select NEW WARD: ",X:DTIME S:'$T X="^" G:"^"[X QUIT W:X?1."?" !!,"Enter the new Ward you wish to replace ",$P(^DIC(42,OLD,0),"^"),".",!
|
|---|
| 12 | S DIC="^DIC(42,",DIC(0)="QEM",DIC("S")="I $S(+Y=OLD:0,'$D(^(""I"")):1,^(""I"")="""":1,1:0)" D ^DIC K DIC G:Y<0 NEW S NEW=+Y
|
|---|
| 13 | QUE F QQ=0:0 W !!,"Do you want to queue this job" S %=1 D YN^DICN Q:% W !!,"If you want to queue this job to run at a later time, accept the ",!,"default, otherwise enter 'N' to run it immediately or '^' to Exit"
|
|---|
| 14 | G:%<0 QUIT S QUE=$S(%=1:1,1:0) I QUE W !!,"You will be notified by MailMan when the job is completed.",!
|
|---|
| 15 | I %=1 S ZTIO="",ZTRTN="START^PSGWCHG",ZTDESC="AR/WS MASS WARD CONVERSION" S:$D(AOULP) ZTSAVE("AOULP(")="" F G="OLD","NEW","QUE" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 16 | I D ^%ZTLOAD,HOME^%ZIS K ZTSK G QUIT
|
|---|
| 17 | START ;
|
|---|
| 18 | K ^TMP("PSGWOLD",$J) S (ITEMCNT,MEDRCNT)=0
|
|---|
| 19 | F DRUG=0:0 S DRUG=$O(^PSI(58.1,"D",DRUG)) Q:'DRUG F MEDR=0:0 S MEDR=$O(^PSI(58.1,"D",DRUG,OLD,MEDR)) Q:'MEDR I $D(AOULP(MEDR)) S ITEM=$O(^PSI(58.1,MEDR,1,"B",DRUG,0)) I +ITEM S ^TMP("PSGWOLD",$J,MEDR,ITEM)=""
|
|---|
| 20 | I $D(^TMP("PSGWOLD",$J)) F MEDR=0:0 S MEDR=$O(^TMP("PSGWOLD",$J,MEDR)) Q:'MEDR S MEDRCNT=MEDRCNT+1 F ITEM=0:0 S ITEM=$O(^TMP("PSGWOLD",$J,MEDR,ITEM)) Q:'ITEM S ITEMCNT=ITEMCNT+1 D CHK
|
|---|
| 21 | I 'QUE W *7,!!,"Total Stock Items converted: ",ITEMCNT,!,"Total AOU(s) converted: ",MEDRCNT,! G QUIT
|
|---|
| 22 | MAIL ;
|
|---|
| 23 | K XMY D NOW^%DTC S Y=X X ^DD("DD") S RDT=Y S ^TMP("PSGWMSG",$J,1,0)="AR/WS Ward Conversion Background job has run to completion.",^TMP("PSGWMSG",$J,2,0)="Run Date: "_RDT,^TMP("PSGWMSG",$J,3,0)=""
|
|---|
| 24 | S ^TMP("PSGWMSG",$J,4,0)="Old Ward: "_$P(^DIC(42,OLD,0),"^")_" converted to New Ward: "_$P(^DIC(42,NEW,0),"^"),^TMP("PSGWMSG",$J,5,0)="Total number of AOUs converted: "_MEDRCNT
|
|---|
| 25 | S ^TMP("PSGWMSG",$J,6,0)="Total number of Stock Items converted: "_ITEMCNT
|
|---|
| 26 | S XMSUB="AR/WS MASS WARD CONVERSION SUMMARY",XMDUZ="INPATIENT PHARMACY AR/WS",XMTEXT="^TMP(""PSGWMSG"",$J,",XMY(DUZ)="" S:'$D(XMY) XMY(.5)="" D ^XMD K XMY
|
|---|
| 27 | QUIT K %,AOU,DRUG,G,QUE,I,ITEMCNT,J,K,MEDR,MEDRCNT,NEW,OLD,QQ,RDT,SEL,IGDA,JJ,X,XMDUZ,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,XMZ,Y,^TMP("PSGWOLD",$J),^TMP("PSGWMSG",$J),ZTSK,%H,%I,CNT,DA,DR,ITEM,MEDRCNT,XCNP,AOULP
|
|---|
| 28 | S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 29 | CHK ;
|
|---|
| 30 | K DA S DA(2)=MEDR,DA(1)=ITEM,DA=OLD,DIK="^PSI(58.1,"_DA(2)_",1,"_DA(1)_",4," D ^DIK K DIK
|
|---|
| 31 | I '$D(^PSI(58.1,MEDR,1,ITEM,4,NEW,0)) K DA S DA(2)=MEDR,DA(1)=ITEM,DA=NEW,DIE="^PSI(58.1,"_DA(2)_",1,"_DA(1)_",4,",DR=".01////"_NEW D ^DIE K DIE I 'QUE W "."
|
|---|
| 32 | S CNT=0 F I=0:0 S I=$O(^PSI(58.1,MEDR,1,ITEM,4,I)) Q:'I S CNT=CNT+1
|
|---|
| 33 | S $P(^PSI(58.1,MEDR,1,ITEM,4,0),"^",3,4)=NEW_"^"_CNT
|
|---|
| 34 | Q
|
|---|
