| [613] | 1 | PSSSOLI1 ;BIR/RTR-Manual match Solutions to Orderable Items continued ; 09/01/98 7:13
|
|---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
|
|---|
| 3 | ADD ;
|
|---|
| 4 | S PSND=$G(^PSDRUG(PSDISP,"ND")),PSND1=$P(PSND,"^"),PSND3=$P(PSND,"^",3),DA=PSND1,K=PSND3
|
|---|
| 5 | I PSND1,PSND3 S X=$$PSJDF^PSNAPIS(DA,K) S PSDOSPTR=$P(X,"^")
|
|---|
| 6 | I $G(PSDOSPTR),$D(^PS(50.606,PSDOSPTR,0)) S PSDOSNM=$P(^(0),"^") W !!?3,"*** Dose Form from NDF: ",PSDOSNM G PASS
|
|---|
| 7 | W ! K DIC S DIC="^PS(50.606,",DIC(0)="QEAMZ",DIC("A")="Select Dose Form: " D ^DIC K DIC I Y<1!($D(DTOUT))!($D(DUOUT)) G ^PSSSOLIT
|
|---|
| 8 | S PSDOSPTR=+Y,PSDOSNM=$P($G(^PS(50.606,PSDOSPTR,0)),"^")
|
|---|
| 9 | PASS S PSOIDOSE=PSDOSPTR W !!,"Solution Name -> ",$G(PSSNAME),!," Volume -> ",$G(PSSVOL),!," Dose Form -> ",PSDOSNM
|
|---|
| 10 | S XXX=PSSNAME D CHECK
|
|---|
| 11 | S PSANS=0 I ZZFLAG W $C(7),!!,"There is already an Orderable Item named:",!?5,$P($G(^PS(50.7,ZZFLAG,0)),"^")_" "_$P($G(^PS(50.606,+$P(^(0),"^",2),0)),"^"),!
|
|---|
| 12 | I K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Match to this Orderable Item" D ^DIR S PSANS=Y K DIR I Y["^"!($D(DTOUT)) G ^PSSSOLIT
|
|---|
| 13 | I PSANS W !!,"Matching: ",PSSNAME_" "_$G(PSSVOL),!," to",!,$P($G(^PS(50.7,ZZFLAG,0)),"^")_" "_$G(PSDOSNM) W ! K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this OK" D ^DIR G:Y=1 SOMAT^PSSSUTIL G:Y["^"!($D(DTOUT)) ^PSSSOLIT
|
|---|
| 14 | XDIR W ! K DIR S DIR(0)="F^3:40",DIR("A")="Enter Orderable Item Name" S X=PSSNAME D INPUT I $L(PSSNAME)>2,$L(PSSNAME)<41,'INFLAG S DIR("B")=PSSNAME
|
|---|
| 15 | D ^DIR K DIR I Y["^"!(Y="")!($D(DUOUT))!($D(DTOUT)) G ^PSSSOLIT
|
|---|
| 16 | S HOLDOI=X
|
|---|
| 17 | D INPUT I INFLAG W $C(7),!?5,"??",! G XDIR
|
|---|
| 18 | S PPFLAG=0 F QQ=0:0 S QQ=$O(^PS(50.7,"ADF",HOLDOI,PSOIDOSE,QQ)) Q:'QQ!(PPFLAG) I QQ,$P($G(^PS(50.7,QQ,0)),"^",3) S PPFLAG=QQ
|
|---|
| 19 | I PPFLAG W !!,"Matching: ",PSSNAME_" "_$G(PSSVOL),!," to",!,$P($G(^PS(50.7,PPFLAG,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")
|
|---|
| 20 | I W ! K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this OK" D ^DIR K DIR W ! G:Y["^"!($D(DTOUT)) ^PSSSOLIT G:Y=0 XDIR
|
|---|
| 21 | I PPFLAG S ZZFLAG=PPFLAG G SOMAT^PSSSUTIL
|
|---|
| 22 | NEW ;Create new entry in 50.7
|
|---|
| 23 | W !!,"Matching: ",PSSNAME_" "_$G(PSSVOL),!," to",!,HOLDOI_" "_PSDOSNM
|
|---|
| 24 | W ! K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this OK" D ^DIR K DIR W ! I Y'=1 G XDIR
|
|---|
| 25 | K DIC,DD,DO S DIC="^PS(50.7,",DIC(0)="L",X=HOLDOI,DIC("DR")=".02////"_PSOIDOSE_";.03////"_1 D FILE^DICN K DIC I Y<1 W !!,"Unable to create entry, try again!",! G XDIR
|
|---|
| 26 | S PSNEWOI=+Y S SCOUNT=0 F SS=0:0 S SS=$O(^PS(52.7,PSSIEN,3,SS)) Q:'SS S SCOUNT=SCOUNT+1,SYN(SCOUNT)=^(SS,0)
|
|---|
| 27 | K DIE S DIE="^PS(52.7,",DA=PSSIEN,DR="9////"_PSNEWOI D ^DIE K DIE
|
|---|
| 28 | I SCOUNT S ^PS(50.7,PSNEWOI,2,0)="^50.72^"_SCOUNT_"^"_SCOUNT F WW=0:0 S WW=$O(SYN(WW)) Q:'WW S ^PS(50.7,PSNEWOI,2,WW,0)=SYN(WW)
|
|---|
| 29 | S NEWFLAG=1 S PSSOI=PSNEWOI D DIR^PSSPOIM3 I $G(PSSDIR) W !!?3,"Now editing Orderable Item:",!?3,$P(^PS(50.7,PSSOI,0),"^")," ",$P($G(^PS(50.606,+$P(^(0),"^",2),0)),"^") D INACT^PSSSOLIT
|
|---|
| 30 | K NEWFLAG,PSSDIR D EN^PSSPOIDT(PSSOI) D:'$G(PSSSSS) EN2^PSSHL1(PSSOI,"MAD")
|
|---|
| 31 | G ^PSSSOLIT
|
|---|
| 32 | INPUT S INFLAG=0 I X[""""!($A(X)=45)!('(X'?1P.E))!(X?2"z".E) S INFLAG=1
|
|---|
| 33 | Q
|
|---|
| 34 | CHECK ;
|
|---|
| 35 | S (ZZFLAG,ZZXFLAG)=0 F VV=0:0 S VV=$O(^PS(50.7,"ADF",XXX,PSOIDOSE,VV)) Q:'VV S:VV&($P($G(^PS(50.7,VV,0)),"^",3)) (ZZFLAG,ZZXFLAG)=VV
|
|---|
| 36 | Q
|
|---|
