source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSALFM.m@ 1046

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1PSALFM ;BIR/LTL-Controlled Connection by FSN Match ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
3 ;
4 D DT^DICRW
5START ;compiles data for edit
6EXPL W !,"I'll loop through the FSNs in your DRUG file.",!,"If I find a match in the ITEM MASTER file, I'll let you know.",!
7 N D0,D1,DA,DIC,DIE,DIR,DIRUT,DIW,DIWF,DIWL,DIWR,DIWT,DLAYGO,DR,DTOUT,DUOUT,PSA,PSAD,PSADD,PSAF,PSAFSN,PSAIT,PSAOUT,X,Y S (PSA,PSAD)=0
8LOOP F S PSAD=$O(^PSDRUG(PSAD)) G:'PSAD!($D(PSAOUT)) END I $P($G(^PSDRUG(PSAD,0)),U,6)]"",'$O(^PSDRUG(PSAD,441,0)),'$D(^PSDRUG(PSAD,"I")) D G:$G(PSAOUT) END
9 .I $Y+5>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y PSAOUT=1 W @IOF Q
10FORM .S PSAFSN=$P(^PSDRUG(PSAD,0),U,6) W !,PSAFSN D:$O(^PRC(441,"BB",PSAFSN,0))
11 ..N PSADD S PSAIT=$O(^PRC(441,"BB",PSAFSN,"")) D W !,$E($P(^PSDRUG(PSAD,0),U),1,39)
12USED ...I $O(^PSDRUG("AB",PSAIT,"")) S PSADD=$O(^PSDRUG("AB",PSAIT,"")) W !,"**"_$P(^PSDRUG(PSADD,0),U)_" is already linked to Item #"_PSAIT_"**"
13INAC ...I $E($G(^PRC(441,PSAIT,3)),1)=1 W !,"Sorry, Item #"_PSAIT_" is INACTIVE, can't link.",! S PSADD=""
14 ..I $L($G(^PRC(441,+PSAIT,1,1,0)))<40,'$O(^PRC(441,+PSAIT,1,1)) W ?40,$G(^PRC(441,+PSAIT,1,1,0)),! G SH
15 ..K ^UTILITY($J,"W") S DIWL=40,DIWR=80,DIWF="W"
16 ..F S PSA=$O(^PRC(441,+PSAIT,1,PSA)) Q:'PSA S X=$G(^PRC(441,+PSAIT,1,PSA,0)) D ^DIWP
17 ..D ^DIWW S PSA=0
18SH ..D:'$D(PSADD) OFFER
19END I '$G(PSAOUT) S DIR(0)="EA",DIR("A")="Done with FSN's. Press <RET> to return to the menu." D ^DIR
20QUIT Q
21OFFER S DIR(0)="Y",DIR("A")="Do we have a match",DIR("B")="Yes" D ^DIR K DIR S:$D(DIRUT) PSAOUT=1 Q:'Y D
22OK S DIE=50,DA=PSAD,DR="441///^S X=PSAIT" D ^DIE W " Linked to Item #"_PSAIT
Note: See TracBrowser for help on using the repository browser.