source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWBGIN.m@ 1144

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1PSGWBGIN ;BHAM ISC/CML-AR/WS Item Inactivation ; 06 Aug 93 / 2:19 PM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3 W !!,"You may inactivate a Stock Item for a single AOU,",!,"or enter ""^ALL"" to inactivate the Item in ALL AOUs.",!
4 K QFLG F QQ=0:0 Q:$D(QFLG) S ALL=1,DIC="^PSI(58.1,",DIC(0)="QEAM" D ^DIC K DIC Q:Y<0&(X'="^ALL") D:X'="^ALL" INACT2 I ALL F QQ=0:0 D ASK Q:$D(QFLG) I $D(X),"^"[X Q
5QUIT K %,ALL,AOU,AOUCNT,DA,DR,QUE,QFLG,I,ITEM,ITEMNUM,INDT,J,K,QQ,REA1,REA2,RDT,X,XMDUZ,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,XMZ,Y,^TMP("PSGWMSG",$J),ZTSK
6 S:$D(ZTQUEUED) ZTREQ="@" Q
7ASK ;
8 W !!,"Select ITEM: " R X:DTIME S:'$T X="^",QFLG=1 Q:"^"[X W:X?1."?" !!,"Enter the ITEM you wish to inactivate in all AOUs.",! S DIC="^PSDRUG(",DIC(0)="QEOM" D ^DIC K DIC G:Y<0 ASK S ITEM=+Y,REA2=""
9 W !!,"Select INACTIVATION REASON:",!?5,"(N) - NOT USED",!?5,"(DF) - DELETED FROM FORMULARY",!?5,"(O) - OTHER"
10ASKR1 R ?34,"=> ",REA1:DTIME S:'$T REA1="^",QFLG=1 Q:"^"[REA1 G:REA1="O" ASKR2 I REA1'="N",REA1'="DF" W *7,!?37,"Enter 'N', 'DF', or 'O'",! G ASKR1
11 G QUE
12ASKR2 R !!,"Enter INACTIVATION REASON (OTHER): ",REA2:DTIME S:'$T REA2="^",QFLG=1 Q:REA2="^" I REA2]"",REA2?1."?"!($L(REA2)>40!($L(REA2)<3)) W *7,!?5,"ANSWER MUST BE 3-40 CHARACTERS IN LENGTH" G ASKR2
13QUE F QQ=0:0 W !!,"Do you want to queue this job" S %=1 D YN^DICN Q:% W !!,"To queue this job to run at a later time and free up your terminal now, accept",!,"the default, otherwise enter 'N' to run it immediately or '^' to Exit"
14 Q:%<0 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^PSGWBGIN",ZTDESC="AR/WS MASS ITEM INACTIVATION",ZTSAVE("ITEM")="",ZTSAVE("REA1")="",ZTSAVE("REA2")="",ZTSAVE("QUE")="" D ^%ZTLOAD,HOME^%ZIS K ZTSK Q
16START ;
17 D NOW^%DTC S INDT=X,AOUCNT=0 F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU I $D(^PSI(58.1,AOU,1,"B",ITEM)) S ITEMNUM=$O(^PSI(58.1,AOU,1,"B",ITEM,0)) I $D(^PSI(58.1,AOU,1,ITEMNUM,0)),$P(^(0),"^",3)="" D INACT1 S AOUCNT=AOUCNT+1
18 I 'QUE W *7,!!,$P(^PSDRUG(ITEM,0),"^")," has been inactivated in ",AOUCNT," AOU(s).",! Q
19MAIL ;
20 K XMY S Y=INDT X ^DD("DD") S RDT=Y S ^TMP("PSGWMSG",$J,1,0)="AR/WS ITEM Inactivation Background job has run to completion.",^TMP("PSGWMSG",$J,2,0)="Run Date: "_RDT
21 S ^TMP("PSGWMSG",$J,3,0)="",^TMP("PSGWMSG",$J,4,0)="ITEM : "_$P(^PSDRUG(ITEM,0),"^"),^TMP("PSGWMSG",$J,5,0)="Has been inactivated as of "_RDT_" in "_AOUCNT_" AOU(s)."
22 S XMSUB="AR/WS MASS ITEM INACTIVATION SUMMARY",XMDUZ="INPATIENT PHARMACY AR/WS",XMTEXT="^TMP(""PSGWMSG"",$J,",XMY(DUZ)="" S:'$D(XMY) XMY(.5)="" D ^XMD K XMY G QUIT
23INACT1 ; Inactivate an Item for ALL AOUs
24 K DA S DA(1)=AOU,DA=ITEMNUM,DIE="^PSI(58.1,"_DA(1)_",1,",DR="30///"_INDT_";31///"_REA1_";33///"_$S(REA2=""&($P(^PSI(58.1,DA(1),1,DA,0),"^",9)]""):"@",1:REA2) D ^DIE K DIE Q
25INACT2 ; Inactivate an Item for a single AOU
26 K DA,DIE S ALL=0,DA=+Y,DIE="^PSI(58.1,",DR="[PSGW INACTIVATE ITEM]" D ^DIE K DIE S:$D(Y) QFLG=1 Q
Note: See TracBrowser for help on using the repository browser.