PSSPOIMN.m

PSSPOIMN ;BIR/RTR/WRT-Orderable Item manual create ;29-May-2012 15:18;PLS

 ;;1.0;PHARMACY DATA MANAGEMENT;**15,32,34,38,51,57,1013,82,125,1015**;9/30/97;Build 62

 ;

 ;Reference to ^PS(59 supported by DBIA #1976

 ;Reference to $$PSJDF^PSNAPIS(P1,P3) supported by DBIA #2531

 ;Reference to $$VAGN^PSNAPIS(P1) supported by DBIA #2531

 ;

 ;Modified - IHS/MSC/MGH - 02/08/2012 - Line BEG+2

 ;

 S PSSITE=+$O(^PS(59.7,0)) I +$P($G(^PS(59.7,PSSITE,80)),"^",2)<2 W !!?3,"Orderable Item Auto-Create has not been completed yet!",! K PSSITE,DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR Q

 K PSSITE D MESS^PSSPOIM1

BEG I $D(PSIEN) L -^PSDRUG(PSIEN)

 K PSSCROSS,DOSEFV,DOSEFORM,POINT,SPHOLD,NEWSP,PSVAR1,PSITEM,PSTOP,PSMASTER,DIC("S")

 ;IHS/MSC/MGH changed for mixed case lookup, uses new cross-reference

 ;S PSOUT=0 W !! K DIC S DIC(0)="QEAM",DIC="^PSDRUG(",DIC("A")="Select DISPENSE DRUG: "

 S PSOUT=0 W !! K DIC S DIC(0)="QEAM",D="BCAP",DIC="^PSDRUG(",DIC("A")="Select DISPENSE DRUG: "

 ;DIC("S")="I $P($G(^PSDRUG(+Y,2)),""^"",3)[""I""!($P($G(^(2)),""^"",3)[""O"")!($P($G(^(2)),""^"",3)[""U"")"

 ;D ^DIC G:$D(DTOUT)!($D(DUOUT))!(Y<1) END K DIC("S") S PSIEN=+Y,PSNAME=$P(^PSDRUG(PSIEN,0),"^") L +^PSDRUG(PSIEN):0 I '$T W !,$C(7),"Another person is editing this one." Q

 D IX^DIC G:$D(DTOUT)!($D(DUOUT))!(Y<1) END K DIC("S") S PSIEN=+Y,PSNAME=$P(^PSDRUG(PSIEN,0),"^") L +^PSDRUG(PSIEN):0 I '$T W !,$C(7),"Another person is editing this one." Q

MAS I $G(PSMASTER) S PSOUT=0 N DOSEFV,DOSEFORM,POINT,SPHOLD,NEWSP,PSVAR1,PSITEM,PSTOP

 S NODE=$G(^PSDRUG(PSIEN,"ND")),DOSEPTR=0,DA=$P(NODE,"^"),X=$$VAGN^PSNAPIS(DA),VAGEN=X I +$P(NODE,"^"),+$P(NODE,"^",3),VAGEN'=0 S K=$P(NODE,"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSEFV=X I DOSEFV'=0 D

 .S DOSEPTR=$P(X,"^"),DOSEFORM=$P(X,"^",2)

 D TMP

 I +$P($G(^PSDRUG(PSIEN,2)),"^") S (POINT,PSITEM)=$P(^(2),"^") W !!,PSNAME," is already matched to",!!,?5,$P($G(^PS(50.7,POINT,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),!

 ;Warn user the Orderable Item is inactive. Display date and option to use.

 I $G(POINT) N PSSIAD D

 .S PSSIAD=$P($G(^PS(50.7,POINT,0)),"^",4) I $G(PSSIAD) S Y=PSSIAD D DD^%DT W !,"This Orderable Item has an Inactive Date.  *** "_Y,!,"To modify the Orderable Item, use the 'Edit Orderable Item' option."

 I $G(POINT) D  W ! K DIR S DIR("B")="NO",DIR(0)="Y",DIR("A")="Do you want to match to a different Orderable Item" D ^DIR K DIR D:Y=1 MORE,SET,REM D SETX G:$G(PSMASTER) END G BEG

 .K PSSDXLF

 D MCH

 G:'$G(PSMASTER) BEG

END I $D(PSIEN) I '$G(PSSHUIDG) D DRG^PSSHUIDG(PSIEN) D  L -^PSDRUG(PSIEN)

 .N XX,DVER,DNSNAM,DNSPORT,DMFU S XX=""

 .F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX  D

 ..S DVER=$$GET1^DIQ(59,XX_",",105,"I"),DMFU=$$GET1^DIQ(59,XX_",",105.2)

 ..I DVER="2.4" S DNSNAM=$$GET1^DIQ(59,XX_",",2006),DNSPORT=$$GET1^DIQ(59,XX_",",2007) I DNSNAM'=""&(DMFU="YES") D DRG^PSSDGUPD(PSIEN,"",DNSNAM,DNSPORT)

 G END^PSSPOIM1

REM D TMP

 I $O(^TMP($J,"PSSOO",0)) H 1 D OTHER^PSSPOIM1,DISP

 Q:$G(PSOUT)  I $O(^TMP($J,"PSSOO",0)),$G(MATCH) S PSSP=MATCH D ^PSSPOIM1 Q:(PSOUT)!(PSNO)  S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_MATCH  D ^DIE K DIE S PSITEM=MATCH D COM Q

 G MCHA

TMP K ^TMP($J,"PSSOO") S PSCNT=0 I +$P(NODE,"^"),+$P(NODE,"^",3) F ZZ=0:0 S ZZ=$O(^PSDRUG("AND",+NODE,ZZ)) Q:'ZZ  I +$P($G(^PSDRUG(ZZ,2)),"^"),$P(^PSDRUG(ZZ,2),"^")'=$G(POINT),$D(^PS(50.7,$P(^PSDRUG(ZZ,2),"^"),0)) S OTH=$G(^PSDRUG(ZZ,"ND")) D

 .I +$P(OTH,"^"),+$P(OTH,"^",3),DOSEFV'=0 S DA=$P(OTH,"^"),K=$P(OTH,"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSA=X I DOSA'=0,DOSEFV=DOSA D

 ..S NOFLAG=0,TMPTR=$P(^PSDRUG(ZZ,2),"^") F FFF=0:0 S FFF=$O(^TMP($J,"PSSOO",FFF)) Q:'FFF  I $P(^TMP($J,"PSSOO",FFF),"^")=TMPTR S NOFLAG=1

 ..I 'NOFLAG S PSCNT=PSCNT+1 S ^TMP($J,"PSSOO",PSCNT)=$P(^PSDRUG(ZZ,2),"^")_"^"_ZZ

 Q

DISP S MATCH=0 F TT=0:0 S TT=$O(^TMP($J,"PSSOO",TT)) Q:'TT  S SPT=$P(^TMP($J,"PSSOO",TT),"^") W !,TT,"  ",$P($G(^PS(50.7,SPT,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^") I $Y+5>IOSL D  Q:Y=0  I Y="" S PSOUT=1 Q

 .W ! K DIR S DIR(0)="E" D ^DIR I Y W @IOF W !,?3,"Dispense Drug -> ",PSNAME,!

DISPO Q:$G(PSOUT)  W ! K DIR S DIR(0)="N",DIR("A")="Choose number of Orderable Item to match, or '^' to enter a new one" D ^DIR K DIR I Y=""!($D(DTOUT)) S PSOUT=1 Q

 Q:Y["^"  I '$D(^TMP($J,"PSSOO",+Y)) W !!,?5,"INVALID NUMBER" G DISPO

 S MATCH=$P(^TMP($J,"PSSOO",+Y),"^") Q

 S PSOUT=1 Q

MCH I $O(^TMP($J,"PSSOO",0)) H 1 D OTHER^PSSPOIM1,DISP

 Q:$G(PSOUT)  I $O(^TMP($J,"PSSOO",0)),$G(MATCH) S PSSP=MATCH D ^PSSPOIM1 Q:(PSOUT)!(PSNO)  K DIE S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_MATCH D ^DIE S PSITEM=MATCH D COM Q

MCHA W ! I $G(DOSEFORM)'="" W !?3,"Dosage Form -> ",DOSEFORM,!! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Match to another Orderable Item with same Dosage Form" D ^DIR G:Y=1 LOOK I Y["^"!(Y="")!($D(DTOUT)) Q

 I $G(DOSEFORM)="" K DIC S DIC="^PS(50.606,",DIC(0)="QEAMZ",DIC("A")="Choose Dosage Form: " D ^DIC Q:$D(DTOUT)!($D(DUOUT))!(Y<1)  S DOSEPTR=+Y W !!?3,"Dose Form -> ",$G(Y(0,0))

 I $G(DOSEFORM)="" K DIR W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Match to another Orderable Item with same Dosage Form" D ^DIR

 I $G(DOSEFORM)="" Q:$D(DTOUT)!($D(DUOUT))!(Y<0)  S DOSEFORM=$P(^PS(50.606,DOSEPTR,0),"^") G:Y>0 LOOK

MCHAN W !! I $L(VAGEN)>40 W !,"VA Generic Name -> ",VAGEN,!

 W !,?3,"Dosage Form   -> ",DOSEFORM,!,?3,"Dispense Drug -> ",PSNAME,!!

 K DIR S DIR(0)="F^3:40",DIR("A")="Orderable Item Name" S:$L(VAGEN)>2&($L(VAGEN)<41) DIR("B")=VAGEN

 D ^DIR Q:$D(DUOUT)!($D(DTOUT))!(Y["^")!(Y="")

 I X[""""!($A(X)=45)!('(X'?1P.E))!(X?2"z".E) W $C(7),!!?5,"??" G MCHAN

 S (X,SPHOLD)=Y,(STOP,PSNO)=0 F COMM=0:0 S COMM=$O(^PS(50.7,"ADF",SPHOLD,DOSEPTR,COMM)) Q:'COMM!(STOP)!($G(PSOUT))  I COMM,$P($G(^PS(50.7,COMM,0)),"^",3)="" D

 .S PSSP=COMM D ^PSSPOIM1 S:PSNO STOP=1 Q:PSOUT!(STOP)  K DIE S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_COMM D ^DIE S PSITEM=COMM D COM S STOP=1 Q

 Q:PSOUT

 I STOP,$G(PSNO) G MCHAN

 Q:STOP

 S PSMAN=1

 D ^PSSPOIM1

 G:PSNO MCHAN Q:PSOUT  K DIC S DIC="^PS(50.7,",DIC(0)="L",X=SPHOLD,DIC("DR")=".02////"_DOSEPTR K DD,DO D FILE^DICN K DD,DO D:Y<1  G:(Y<1) MCHAN S NEWSP=+Y,DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_NEWSP D ^DIE S PSVAR1=1,PSITEM=NEWSP D COM Q

 .W $C(7),!?5,"Invalid entry!",!! Q

 Q

LOOK W !!!?3,"Enter ?? for Pharmacy Orderable Item List!",!

 K DIC S DIC="^PS(50.7,",DIC(0)="QEAM",DIC("S")="I $P($G(^(0)),""^"",2)=DOSEPTR,$P($G(^(0)),""^"",3)=""""" D ^DIC I Y>0 S (NEWSP,PSSP)=+Y D ^PSSPOIM1 G:PSNO LOOK Q:PSOUT  S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_NEWSP D ^DIE S PSITEM=NEWSP D COM Q

 W ! K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Create a new Orderable Item to match" D ^DIR I Y=1 G MCHAN

 Q

COM W !,"Match Complete!",! D EN^PSSPOIM1(PSITEM) Q

 ;

SET ;

 S PSSDXLF=1,PSSDXL=+$P($G(^PS(50.7,+$G(POINT),0)),"^",2)

 Q

SETX ;

 I $G(PSSDXLF),$G(PSSDXL),$G(PSITEM),$G(PSSDXL)'=+$P($G(^PS(50.7,+$G(PSITEM),0)),"^",2) K ^PSDRUG(PSIEN,"DOS2") I $G(PSIEN) D EN2^PSSUTIL(PSIEN,1)

 K PSSDXL,PSSDXLF

 Q

MORE ;Show Additives and Solutions

 Q:'$G(PSIEN)

 N PSSMORA,PSSMORS,PSSMZ,PSSMZOUT,PSSMODT

 S (PSSMORA,PSSMORS,PSSMZOUT)=0

 I $O(^PS(52.6,"AC",PSIEN,0)) S PSSMORA=1

 I $O(^PS(52.7,"AC",PSIEN,0)) S PSSMORS=1

 I 'PSSMORA,'PSSMORS Q

 W !!!,"There are "_$S('$G(PSSMORS):"IV Additives",'$G(PSSMORA):"IV Solutions",1:"IV Additives and IV Solutions")_" tied to this Dispense Drug."

 W !,"By rematching the Dispense Drug to a new Pharmacy Orderable Item, all of these",!,$S('$G(PSSMORS):"IV Additives",'$G(PSSMORA):"IV Solutions",1:"IV Additives and IV Solutions")_" will also be rematched to the new Orderable Item.",!

 K DIR S DIR(0)="E",DIR("A")="Press Return to see "_$S('$G(PSSMORS):"IV Additive",'$G(PSSMORA):"IV Solution",1:"IV Additive/Solution")_" list" D ^DIR I Y'=1 W ! Q

 W @IOF

 W !,$S('$G(PSSMORA):"IV Solutions",'$G(PSSMORS):"IV Additives",1:"IV Additives/Solutions"),!,"------------" I $G(PSSMORS),$G(PSSMORA) W "----------"

 I $G(PSSMORA) D  G:$G(PSSMZOUT) MOREZ

 .F PSSMZ=0:0 S PSSMZ=$O(^PS(52.6,"AC",PSIEN,PSSMZ)) Q:'PSSMZ!($G(PSSMZOUT))  D

 ..D:($Y+5)>IOSL MOREH Q:$G(PSSMZOUT)

 ..W !,$P($G(^PS(52.6,PSSMZ,0)),"^"),?42,"(A)"

 ..S PSSMODT=$P($G(^PS(52.6,PSSMZ,"I")),"^") I PSSMODT D MODT

 ;I $G(PSSMORA),$G(PSSMORS) W !

 I $G(PSSMORS) D

 .F PSSMZ=0:0 S PSSMZ=$O(^PS(52.7,"AC",PSIEN,PSSMZ)) Q:'PSSMZ!($G(PSSMZOUT))  D

 ..D:($Y+5)>IOSL MOREH Q:$G(PSSMZOUT)

 ..W !,$P($G(^PS(52.7,PSSMZ,0)),"^"),?31,$P($G(^(0)),"^",3),?42,"(S)"

 ..S PSSMODT=$P($G(^PS(52.7,PSSMZ,"I")),"^") I PSSMODT D MODT

MOREZ ;

 I '$G(PSSMZOUT) W ! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR

 Q

 ;

MOREH ;

 W ! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR I 'Y S PSSMZOUT=1 Q

 W @IOF

 Q

MODT ;

 S Y=$G(PSSMODT) I $G(Y) D DD^%DT W ?50,$G(Y) K Y

 Q

PSSPOIMN  ;BIR/RTR/WRT-Orderable Item manual create ;29-May-2012 15:18;PLS

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**15,32,34,38,51,57,1013,82,125,1015**;9/30/97;Build 62

 +2       ;

 +3       ;Reference to ^PS(59 supported by DBIA #1976

 +4       ;Reference to $$PSJDF^PSNAPIS(P1,P3) supported by DBIA #2531

 +5       ;Reference to $$VAGN^PSNAPIS(P1) supported by DBIA #2531

 +6       ;

 +7       ;Modified - IHS/MSC/MGH - 02/08/2012 - Line BEG+2

 +8       ;

 +9        SET PSSITE=+$ORDER(^PS(59.7,0))

           IF +$PIECE($GET(^PS(59.7,PSSITE,80)),"^",2)<2

               WRITE !!?3,"Orderable Item Auto-Create has not been completed yet!",!

               KILL PSSITE,DIR

               SET DIR(0)="E"

               SET DIR("A")="Press RETURN to continue"

               DO ^DIR

               KILL DIR

               QUIT 

 +10       KILL PSSITE

           DO MESS^PSSPOIM1

BEG        IF $DATA(PSIEN)

               LOCK -^PSDRUG(PSIEN)

 +1        KILL PSSCROSS,DOSEFV,DOSEFORM,POINT,SPHOLD,NEWSP,PSVAR1,PSITEM,PSTOP,PSMASTER,DIC("S")

 +2       ;IHS/MSC/MGH changed for mixed case lookup, uses new cross-reference

 +3       ;S PSOUT=0 W !! K DIC S DIC(0)="QEAM",DIC="^PSDRUG(",DIC("A")="Select DISPENSE DRUG: "

 +4        SET PSOUT=0

           WRITE !!

           KILL DIC

           SET DIC(0)="QEAM"

           SET D="BCAP"

           SET DIC="^PSDRUG("

           SET DIC("A")="Select DISPENSE DRUG: "

 +5       ;DIC("S")="I $P($G(^PSDRUG(+Y,2)),""^"",3)[""I""!($P($G(^(2)),""^"",3)[""O"")!($P($G(^(2)),""^"",3)[""U"")"

 +6       ;D ^DIC G:$D(DTOUT)!($D(DUOUT))!(Y<1) END K DIC("S") S PSIEN=+Y,PSNAME=$P(^PSDRUG(PSIEN,0),"^") L +^PSDRUG(PSIEN):0 I '$T W !,$C(7),"Another person is editing this one." Q

 +7        DO IX^DIC

           IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<1)

               GOTO END

           KILL DIC("S")

           SET PSIEN=+Y

           SET PSNAME=$PIECE(^PSDRUG(PSIEN,0),"^")

           LOCK +^PSDRUG(PSIEN):0

           IF '$TEST

               WRITE !,$CHAR(7),"Another person is editing this one."

               QUIT 

MAS        IF $GET(PSMASTER)

               SET PSOUT=0

               NEW DOSEFV,DOSEFORM,POINT,SPHOLD,NEWSP,PSVAR1,PSITEM,PSTOP

 +1        SET NODE=$GET(^PSDRUG(PSIEN,"ND"))

           SET DOSEPTR=0

           SET DA=$PIECE(NODE,"^")

           SET X=$$VAGN^PSNAPIS(DA)

           SET VAGEN=X

           IF +$PIECE(NODE,"^")

               IF +$PIECE(NODE,"^",3)

                   IF VAGEN'=0

                       SET K=$PIECE(NODE,"^",3)

                       SET X=$$PSJDF^PSNAPIS(DA,K)

                       SET DOSEFV=X

                       IF DOSEFV'=0

                           Begin DoDot:1

 +2                            SET DOSEPTR=$PIECE(X,"^")

                               SET DOSEFORM=$PIECE(X,"^",2)

                           End DoDot:1

 +3        DO TMP

 +4        IF +$PIECE($GET(^PSDRUG(PSIEN,2)),"^")

               SET (POINT,PSITEM)=$PIECE(^(2),"^")

               WRITE !!,PSNAME," is already matched to",!!,?5,$PIECE($GET(^PS(50.7,POINT,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^"),!

 +5       ;Warn user the Orderable Item is inactive. Display date and option to use.

 +6        IF $GET(POINT)

               NEW PSSIAD

               Begin DoDot:1

 +7                SET PSSIAD=$PIECE($GET(^PS(50.7,POINT,0)),"^",4)

                   IF $GET(PSSIAD)

                       SET Y=PSSIAD

                       DO DD^%DT

                       WRITE !,"This Orderable Item has an Inactive Date.  *** "_Y,!,"To modify the Orderable Item, use the 'Edit Orderable Item' option."

               End DoDot:1

 +8        IF $GET(POINT)

               Begin DoDot:1

 +9                KILL PSSDXLF

               End DoDot:1

               WRITE !

               KILL DIR

               SET DIR("B")="NO"

               SET DIR(0)="Y"

               SET DIR("A")="Do you want to match to a different Orderable Item"

               DO ^DIR

               KILL DIR

               IF Y=1

                   DO MORE

                   DO SET

                   DO REM

               DO SETX

               IF $GET(PSMASTER)

                   GOTO END

               GOTO BEG

 +10       DO MCH

 +11       IF '$GET(PSMASTER)

               GOTO BEG

END        IF $DATA(PSIEN)

               IF '$GET(PSSHUIDG)

                   DO DRG^PSSHUIDG(PSIEN)

                   Begin DoDot:1

 +1                    NEW XX,DVER,DNSNAM,DNSPORT,DMFU

                       SET XX=""

 +2                    FOR XX=0:0

                           SET XX=$ORDER(^PS(59,XX))

                           IF 'XX

                               QUIT 

                           Begin DoDot:2

 +3                            SET DVER=$$GET1^DIQ(59,XX_",",105,"I")

                               SET DMFU=$$GET1^DIQ(59,XX_",",105.2)

 +4                            IF DVER="2.4"

                                   SET DNSNAM=$$GET1^DIQ(59,XX_",",2006)

                                   SET DNSPORT=$$GET1^DIQ(59,XX_",",2007)

                                   IF DNSNAM'=""&(DMFU="YES")

                                       DO DRG^PSSDGUPD(PSIEN,"",DNSNAM,DNSPORT)

                           End DoDot:2

                   End DoDot:1

                   LOCK -^PSDRUG(PSIEN)

 +5        GOTO END^PSSPOIM1

REM        DO TMP

 +1        IF $ORDER(^TMP($JOB,"PSSOO",0))

               HANG 1

               DO OTHER^PSSPOIM1

               DO DISP

 +2        IF $GET(PSOUT)

               QUIT 

           IF $ORDER(^TMP($JOB,"PSSOO",0))

               IF $GET(MATCH)

                   SET PSSP=MATCH

                   DO ^PSSPOIM1

                   IF (PSOUT)!(PSNO)

                       QUIT 

                   SET DIE="^PSDRUG("

                   SET DA=PSIEN

                   SET DR="2.1////"_MATCH

                   DO ^DIE

                   KILL DIE

                   SET PSITEM=MATCH

                   DO COM

                   QUIT 

 +3        GOTO MCHA

TMP        KILL ^TMP($JOB,"PSSOO")

           SET PSCNT=0

           IF +$PIECE(NODE,"^")

               IF +$PIECE(NODE,"^",3)

                   FOR ZZ=0:0

                       SET ZZ=$ORDER(^PSDRUG("AND",+NODE,ZZ))

                       IF 'ZZ

                           QUIT 

                       IF +$PIECE($GET(^PSDRUG(ZZ,2)),"^")

                           IF $PIECE(^PSDRUG(ZZ,2),"^")'=$GET(POINT)

                               IF $DATA(^PS(50.7,$PIECE(^PSDRUG(ZZ,2),"^"),0))

                                   SET OTH=$GET(^PSDRUG(ZZ,"ND"))

                                   Begin DoDot:1

 +1                                    IF +$PIECE(OTH,"^")

                                           IF +$PIECE(OTH,"^",3)

                                               IF DOSEFV'=0

                                                   SET DA=$PIECE(OTH,"^")

                                                   SET K=$PIECE(OTH,"^",3)

                                                   SET X=$$PSJDF^PSNAPIS(DA,K)

                                                   SET DOSA=X

                                                   IF DOSA'=0

                                                       IF DOSEFV=DOSA

                                                           Begin DoDot:2

 +2                                                            SET NOFLAG=0

                                                               SET TMPTR=$PIECE(^PSDRUG(ZZ,2),"^")

                                                               FOR FFF=0:0

                                                                   SET FFF=$ORDER(^TMP($JOB,"PSSOO",FFF))

                                                                   IF 'FFF

                                                                       QUIT 

                                                                   IF $PIECE(^TMP($JOB,"PSSOO",FFF),"^")=TMPTR

                                                                       SET NOFLAG=1

 +3                                                            IF 'NOFLAG

                                                                   SET PSCNT=PSCNT+1

                                                                   SET ^TMP($JOB,"PSSOO",PSCNT)=$PIECE(^PSDRUG(ZZ,2),"^")_"^"_ZZ

                                                           End DoDot:2

                                   End DoDot:1

 +4        QUIT 

DISP       SET MATCH=0

           FOR TT=0:0

               SET TT=$ORDER(^TMP($JOB,"PSSOO",TT))

               IF 'TT

                   QUIT 

               SET SPT=$PIECE(^TMP($JOB,"PSSOO",TT),"^")

               WRITE !,TT,"  ",$PIECE($GET(^PS(50.7,SPT,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")

               IF $Y+5>IOSL

                   Begin DoDot:1

 +1                    WRITE !

                       KILL DIR

                       SET DIR(0)="E"

                       DO ^DIR

                       IF Y

                           WRITE @IOF

                           WRITE !,?3,"Dispense Drug -> ",PSNAME,!

                   End DoDot:1

                   IF Y=0

                       QUIT 

                   IF Y=""

                       SET PSOUT=1

                       QUIT 

DISPO      IF $GET(PSOUT)

               QUIT 

           WRITE !

           KILL DIR

           SET DIR(0)="N"

           SET DIR("A")="Choose number of Orderable Item to match, or '^' to enter a new one"

           DO ^DIR

           KILL DIR

           IF Y=""!($DATA(DTOUT))

               SET PSOUT=1

               QUIT 

 +1        IF Y["^"

               QUIT 

           IF '$DATA(^TMP($JOB,"PSSOO",+Y))

               WRITE !!,?5,"INVALID NUMBER"

               GOTO DISPO

 +2        SET MATCH=$PIECE(^TMP($JOB,"PSSOO",+Y),"^")

           QUIT 

 +3        SET PSOUT=1

           QUIT 

MCH        IF $ORDER(^TMP($JOB,"PSSOO",0))

               HANG 1

               DO OTHER^PSSPOIM1

               DO DISP

 +1        IF $GET(PSOUT)

               QUIT 

           IF $ORDER(^TMP($JOB,"PSSOO",0))

               IF $GET(MATCH)

                   SET PSSP=MATCH

                   DO ^PSSPOIM1

                   IF (PSOUT)!(PSNO)

                       QUIT 

                   KILL DIE

                   SET DIE="^PSDRUG("

                   SET DA=PSIEN

                   SET DR="2.1////"_MATCH

                   DO ^DIE

                   SET PSITEM=MATCH

                   DO COM

                   QUIT 

MCHA       WRITE !

           IF $GET(DOSEFORM)'=""

               WRITE !?3,"Dosage Form -> ",DOSEFORM,!!

               KILL DIR

               SET DIR(0)="Y"

               SET DIR("B")="NO"

               SET DIR("A")="Match to another Orderable Item with same Dosage Form"

               DO ^DIR

               IF Y=1

                   GOTO LOOK

               IF Y["^"!(Y="")!($DATA(DTOUT))

                   QUIT 

 +1        IF $GET(DOSEFORM)=""

               KILL DIC

               SET DIC="^PS(50.606,"

               SET DIC(0)="QEAMZ"

               SET DIC("A")="Choose Dosage Form: "

               DO ^DIC

               IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<1)

                   QUIT 

               SET DOSEPTR=+Y

               WRITE !!?3,"Dose Form -> ",$GET(Y(0,0))

 +2        IF $GET(DOSEFORM)=""

               KILL DIR

               WRITE !

               SET DIR(0)="Y"

               SET DIR("B")="NO"

               SET DIR("A")="Match to another Orderable Item with same Dosage Form"

               DO ^DIR

 +3        IF $GET(DOSEFORM)=""

               IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<0)

                   QUIT 

               SET DOSEFORM=$PIECE(^PS(50.606,DOSEPTR,0),"^")

               IF Y>0

                   GOTO LOOK

MCHAN      WRITE !!

           IF $LENGTH(VAGEN)>40

               WRITE !,"VA Generic Name -> ",VAGEN,!

 +1        WRITE !,?3,"Dosage Form   -> ",DOSEFORM,!,?3,"Dispense Drug -> ",PSNAME,!!

 +2        KILL DIR

           SET DIR(0)="F^3:40"

           SET DIR("A")="Orderable Item Name"

           IF $LENGTH(VAGEN)>2&($LENGTH(VAGEN)<41)

               SET DIR("B")=VAGEN

 +3        DO ^DIR

           IF $DATA(DUOUT)!($DATA(DTOUT))!(Y["^")!(Y="")

               QUIT 

 +4        IF X[""""!($ASCII(X)=45)!('(X'?1P.E))!(X?2"z".E)

               WRITE $CHAR(7),!!?5,"??"

               GOTO MCHAN

 +5        SET (X,SPHOLD)=Y

           SET (STOP,PSNO)=0

           FOR COMM=0:0

               SET COMM=$ORDER(^PS(50.7,"ADF",SPHOLD,DOSEPTR,COMM))

               IF 'COMM!(STOP)!($GET(PSOUT))

                   QUIT 

               IF COMM

                   IF $PIECE($GET(^PS(50.7,COMM,0)),"^",3)=""

                       Begin DoDot:1

 +6                        SET PSSP=COMM

                           DO ^PSSPOIM1

                           IF PSNO

                               SET STOP=1

                           IF PSOUT!(STOP)

                               QUIT 

                           KILL DIE

                           SET DIE="^PSDRUG("

                           SET DA=PSIEN

                           SET DR="2.1////"_COMM

                           DO ^DIE

                           SET PSITEM=COMM

                           DO COM

                           SET STOP=1

                           QUIT 

                       End DoDot:1

 +7        IF PSOUT

               QUIT 

 +8        IF STOP

               IF $GET(PSNO)

                   GOTO MCHAN

 +9        IF STOP

               QUIT 

 +10       SET PSMAN=1

 +11       DO ^PSSPOIM1

 +12       IF PSNO

               GOTO MCHAN

           IF PSOUT

               QUIT 

           KILL DIC

           SET DIC="^PS(50.7,"

           SET DIC(0)="L"

           SET X=SPHOLD

           SET DIC("DR")=".02////"_DOSEPTR

           KILL DD,DO

           DO FILE^DICN

           KILL DD,DO

           IF Y<1

               Begin DoDot:1

 +13               WRITE $CHAR(7),!?5,"Invalid entry!",!!

                   QUIT 

               End DoDot:1

           IF (Y<1)

               GOTO MCHAN

           SET NEWSP=+Y

           SET DIE="^PSDRUG("

           SET DA=PSIEN

           SET DR="2.1////"_NEWSP

           DO ^DIE

           SET PSVAR1=1

           SET PSITEM=NEWSP

           DO COM

           QUIT 

 +14       QUIT 

LOOK       WRITE !!!?3,"Enter ?? for Pharmacy Orderable Item List!",!

 +1        KILL DIC

           SET DIC="^PS(50.7,"

           SET DIC(0)="QEAM"

           SET DIC("S")="I $P($G(^(0)),""^"",2)=DOSEPTR,$P($G(^(0)),""^"",3)="""""

           DO ^DIC

           IF Y>0

               SET (NEWSP,PSSP)=+Y

               DO ^PSSPOIM1

               IF PSNO

                   GOTO LOOK

               IF PSOUT

                   QUIT 

               SET DIE="^PSDRUG("

               SET DA=PSIEN

               SET DR="2.1////"_NEWSP

               DO ^DIE

               SET PSITEM=NEWSP

               DO COM

               QUIT 

 +2        WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="YES"

           SET DIR("A")="Create a new Orderable Item to match"

           DO ^DIR

           IF Y=1

               GOTO MCHAN

 +3        QUIT 

COM        WRITE !,"Match Complete!",!

           DO EN^PSSPOIM1(PSITEM)

           QUIT 

 +1       ;

SET       ;

 +1        SET PSSDXLF=1

           SET PSSDXL=+$PIECE($GET(^PS(50.7,+$GET(POINT),0)),"^",2)

 +2        QUIT 

SETX      ;

 +1        IF $GET(PSSDXLF)

               IF $GET(PSSDXL)

                   IF $GET(PSITEM)

                       IF $GET(PSSDXL)'=+$PIECE($GET(^PS(50.7,+$GET(PSITEM),0)),"^",2)

                           KILL ^PSDRUG(PSIEN,"DOS2")

                           IF $GET(PSIEN)

                               DO EN2^PSSUTIL(PSIEN,1)

 +2        KILL PSSDXL,PSSDXLF

 +3        QUIT 

MORE      ;Show Additives and Solutions

 +1        IF '$GET(PSIEN)

               QUIT 

 +2        NEW PSSMORA,PSSMORS,PSSMZ,PSSMZOUT,PSSMODT

 +3        SET (PSSMORA,PSSMORS,PSSMZOUT)=0

 +4        IF $ORDER(^PS(52.6,"AC",PSIEN,0))

               SET PSSMORA=1

 +5        IF $ORDER(^PS(52.7,"AC",PSIEN,0))

               SET PSSMORS=1

 +6        IF 'PSSMORA

               IF 'PSSMORS

                   QUIT 

 +7        WRITE !!!,"There are "_$SELECT('$GET(PSSMORS):"IV Additives",'$GET(PSSMORA):"IV Solutions",1:"IV Additives and IV Solutions")_" tied to this Dispense Drug."

 +8        WRITE !,"By rematching the Dispense Drug to a new Pharmacy Orderable Item, all of these",!,$SELECT('$GET(PSSMORS):"IV Additives",'$GET(PSSMORA):"IV Solutions",1:"IV Additives and IV Solutions")_" will also be rematched to the new Orderable Item

.",!

 +9        KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press Return to see "_$SELECT('$GET(PSSMORS):"IV Additive",'$GET(PSSMORA):"IV Solution",1:"IV Additive/Solution")_" list"

           DO ^DIR

           IF Y'=1

               WRITE !

               QUIT 

 +10       WRITE @IOF

 +11       WRITE !,$SELECT('$GET(PSSMORA):"IV Solutions",'$GET(PSSMORS):"IV Additives",1:"IV Additives/Solutions"),!,"------------"

           IF $GET(PSSMORS)

               IF $GET(PSSMORA)

                   WRITE "----------"

 +12       IF $GET(PSSMORA)

               Begin DoDot:1

 +13               FOR PSSMZ=0:0

                       SET PSSMZ=$ORDER(^PS(52.6,"AC",PSIEN,PSSMZ))

                       IF 'PSSMZ!($GET(PSSMZOUT))

                           QUIT 

                       Begin DoDot:2

 +14                       IF ($Y+5)>IOSL

                               DO MOREH

                           IF $GET(PSSMZOUT)

                               QUIT 

 +15                       WRITE !,$PIECE($GET(^PS(52.6,PSSMZ,0)),"^"),?42,"(A)"

 +16                       SET PSSMODT=$PIECE($GET(^PS(52.6,PSSMZ,"I")),"^")