source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDTRA1.m@ 724

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1PSDTRA1 ;BIR/JPW-Transfer Stock AR/WS AOU to NAOU (cont'd) ; 23 Jun 93
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3TO ;loops through local array to obtain NAOU to
4 F LOOP=1:1:($L(NAOUT,",")-1) S NAOU=$P(NAOUT,",",LOOP) D FROM
5MSG ;sends message information
6 K XMY,^TMP("PSDTRA",$J)
7 S XMDUZ="CONTROLLED SUBSTANCES PHARMACY",XMY(PSDUZ)="",XMSUB="CS PHARM STOCK TRANSFER FROM AR/WS",^TMP("PSDTRA",$J,1,0)="Stock Drugs from AR/WS "_$P(^PSI(58.1,AOU,0),"^")_" have been transferred into:"
8 F LOOP=1:1:($L(NAOUT,",")-1) S NAOU=$P(NAOUT,",",LOOP),^TMP("PSDTRA",$J,(LOOP+1),0)=$P(^PSD(58.8,NAOU,0),"^")
9 S:'$D(XMY) XMY(.5)="" S XMTEXT="^TMP(""PSDTRA"",$J," D ^XMD K XMY,^TMP("PSDTRA",$J)
10END K AOU,DA,DIC,DIE,DINUM,DR,PSDRG,PSDR,LOC,LOOP,MTR,NAOU,NAOUT,PSDUZ,STK,TYP,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
11 S:$D(ZTQUEUED) ZTREQ="@"
12 Q
13FROM ;finds drugs and sets data transfer
14 F PSDR=0:0 S PSDR=$O(^PSI(58.1,AOU,1,"B",PSDR)) Q:'PSDR S PSDRG=+$O(^PSI(58.1,AOU,1,"B",PSDR,0)) I PSDRG D
15 .Q:'$D(^PSI(58.1,AOU,1,PSDRG,0))
16 .Q:$P($G(^PSDRUG(PSDR,2)),"^",3)'["N"
17 .I $P(^PSI(58.1,AOU,1,PSDRG,0),"^",3)]"",$P(^(0),"^",3)'>DT Q
18 .I '$D(^PSD(58.8,NAOU,1,0)) S ^(0)="^58.8001IP^^"
19 .Q:$D(^PSD(58.8,NAOU,1,PSDR,0))
20 .K DA,DIC,DIE,DR S DA(1)=NAOU,DIC(0)="L",(DIC,DIE)="^PSD(58.8,"_NAOU_",1,",(X,DINUM)=PSDR K DD,DO D FILE^DICN K DIC
21 .I MTR'=1 S LOC=$P(^PSI(58.1,AOU,1,PSDRG,0),"^",8),STK=$P(^(0),"^",2),DA=PSDR,DA(1)=NAOU,DR="1///"_LOC_";2///"_STK D ^DIE K DIE
22 .I MTR=3,'$D(^PSI(58.1,AOU,1,PSDRG,2,0)) Q
23 .I MTR=3,'$D(^PSD(58.8,NAOU,1,PSDR,2,0)) S ^(0)="^58.800116PA^^"
24 .I MTR=3 F TYP=0:0 S TYP=$O(^PSI(58.1,AOU,1,PSDRG,2,TYP)) Q:'TYP S DA(1)=PSDR,DA(2)=NAOU,DIC="^PSD(58.8,"_NAOU_",1,"_PSDR_",2,",DIC(0)="L",(X,DINUM)=TYP K DD,DO D FILE^DICN K DIC
25 Q
Note: See TracBrowser for help on using the repository browser.