- PSALFM ;BIR/LTL-Controlled Connection by FSN Match ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
- ;
- D DT^DICRW
- START ;compiles data for edit
- EXPL 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.",!
- 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
- LOOP 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
- .I $Y+5>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y PSAOUT=1 W @IOF Q
- FORM .S PSAFSN=$P(^PSDRUG(PSAD,0),U,6) W !,PSAFSN D:$O(^PRC(441,"BB",PSAFSN,0))
- ..N PSADD S PSAIT=$O(^PRC(441,"BB",PSAFSN,"")) D W !,$E($P(^PSDRUG(PSAD,0),U),1,39)
- USED ...I $O(^PSDRUG("AB",PSAIT,"")) S PSADD=$O(^PSDRUG("AB",PSAIT,"")) W !,"**"_$P(^PSDRUG(PSADD,0),U)_" is already linked to Item #"_PSAIT_"**"
- INAC ...I $E($G(^PRC(441,PSAIT,3)),1)=1 W !,"Sorry, Item #"_PSAIT_" is INACTIVE, can't link.",! S PSADD=""
- ..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
- ..K ^UTILITY($J,"W") S DIWL=40,DIWR=80,DIWF="W"
- ..F S PSA=$O(^PRC(441,+PSAIT,1,PSA)) Q:'PSA S X=$G(^PRC(441,+PSAIT,1,PSA,0)) D ^DIWP
- ..D ^DIWW S PSA=0
- SH ..D:'$D(PSADD) OFFER
- END I '$G(PSAOUT) S DIR(0)="EA",DIR("A")="Done with FSN's. Press <RET> to return to the menu." D ^DIR
- QUIT Q
- OFFER 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
- OK S DIE=50,DA=PSAD,DR="441///^S X=PSAIT" D ^DIE W " Linked to Item #"_PSAIT
- PSALFM ;BIR/LTL-Controlled Connection by FSN Match ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
- +2 ;
- +3 DO DT^DICRW
- START ;compiles data for edit
- EXPL WRITE !,"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.",!
- +1 NEW 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
- SET (PSA,PSAD)=0
- LOOP FOR
- SET PSAD=$ORDER(^PSDRUG(PSAD))
- IF 'PSAD!($DATA(PSAOUT))
- GOTO END
- IF $PIECE($GET(^PSDRUG(PSAD,0)),U,6)]""
- IF '$ORDER(^PSDRUG(PSAD,441,0))
- IF '$DATA(^PSDRUG(PSAD,"I"))
- Begin DoDot:1
- +1 IF $Y+5>IOSL
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSAOUT=1
- WRITE @IOF
- QUIT
- FORM SET PSAFSN=$PIECE(^PSDRUG(PSAD,0),U,6)
- WRITE !,PSAFSN
- IF $ORDER(^PRC(441,"BB",PSAFSN,0))
- Begin DoDot:2
- +1 NEW PSADD
- SET PSAIT=$ORDER(^PRC(441,"BB",PSAFSN,""))
- Begin DoDot:3
- USED IF $ORDER(^PSDRUG("AB",PSAIT,""))
- SET PSADD=$ORDER(^PSDRUG("AB",PSAIT,""))
- WRITE !,"**"_$PIECE(^PSDRUG(PSADD,0),U)_" is already linked to Item #"_PSAIT_"**"
- INAC IF $EXTRACT($GET(^PRC(441,PSAIT,3)),1)=1
- WRITE !,"Sorry, Item #"_PSAIT_" is INACTIVE, can't link.",!
- SET PSADD=""
- End DoDot:3
- WRITE !,$EXTRACT($PIECE(^PSDRUG(PSAD,0),U),1,39)
- +1 IF $LENGTH($GET(^PRC(441,+PSAIT,1,1,0)))<40
- IF '$ORDER(^PRC(441,+PSAIT,1,1))
- WRITE ?40,$GET(^PRC(441,+PSAIT,1,1,0)),!
- GOTO SH
- +2 KILL ^UTILITY($JOB,"W")
- SET DIWL=40
- SET DIWR=80
- SET DIWF="W"
- +3 FOR
- SET PSA=$ORDER(^PRC(441,+PSAIT,1,PSA))
- IF 'PSA
- QUIT
- SET X=$GET(^PRC(441,+PSAIT,1,PSA,0))
- DO ^DIWP
- +4 DO ^DIWW
- SET PSA=0
- SH IF '$DATA(PSADD)
- DO OFFER
- End DoDot:2
- End DoDot:1
- IF $GET(PSAOUT)
- GOTO END
- END IF '$GET(PSAOUT)
- SET DIR(0)="EA"
- SET DIR("A")="Done with FSN's. Press <RET> to return to the menu."
- DO ^DIR
- QUIT QUIT
- OFFER SET DIR(0)="Y"
- SET DIR("A")="Do we have a match"
- SET DIR("B")="Yes"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET PSAOUT=1
- IF 'Y
- QUIT
- Begin DoDot:1
- End DoDot:1
- OK SET DIE=50
- SET DA=PSAD
- SET DR="441///^S X=PSAIT"
- DO ^DIE
- WRITE " Linked to Item #"_PSAIT
