- PSSPOIM2 ;BIR/RTR/WRT-Orderable Item manual create - initial create ; 09/01/98 7:12
- ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
- D WOOPS H 2 Q:$D(^TMP("PSSLOOP"))
- S PSSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,PSSITE,80)),"^",2)'=2 W !!?3,$S($P($G(^(80)),"^",2)<2:"Orderable Item Auto-Create has not been completed!",1:"Manual matching process complete!"),!! K PSSITE D Q
- .K DIR S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
- S PSOUT=0 D MESSZ^PSSPOIM1 G:$G(PSOUT) CHECK
- S PSCREATE=1 D ^PSSPOIM3 G:$G(PSOOOUT) CHECK
- BEG ;
- W !!?3,"NOW MATCHING DISPENSE DRUGS!",!
- S X1=DT,X2=-365 D C^%DTC S PSXDATE=X,PSOUT=0,AAA=""
- F S AAA=$O(^PSDRUG("B",AAA)) Q:AAA=""!($G(PSOUT)) F PSIEN=0:0 S PSIEN=$O(^PSDRUG("B",AAA,PSIEN)) Q:'PSIEN!($G(PSOUT)) I $G(PSIEN),'$P($G(^PSDRUG(PSIEN,2)),"^") D I ZXX I APLU["I"!(APLU["O")!(APLU["U") S PSNAME=$P(^(0),"^") D START
- .S APLU=$P($G(^PSDRUG(PSIEN,2)),"^",3)
- .S ZXX=1 S PSXDDATE=+$P($G(^PSDRUG(PSIEN,"I")),"^") I PSXDDATE,PSXDDATE<PSXDATE S ZXX=0
- CHECK D CHECK^PSSPOIM1
- G END^PSSPOIM1
- START K DOSEFV,DOSEFORM,POINT,SPHOLD,NEWSP,RESTART W !!!?5,"Dispense Drug -> ",PSNAME
- S NODE=$G(^PSDRUG(PSIEN,"ND")),DOSEPTR=0,DA=$P($G(NODE),"^"),X=$$VAGN^PSNAPIS(DA),VAGEN=X I +$P(NODE,"^"),+$P(NODE,"^",3),$G(VAGEN)'=0 S K=$P($G(NODE),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSEFV=X I $G(DOSEFV)'=0 D
- .S DOSEPTR=$P(X,"^"),DOSEFORM=$P(X,"^",2)
- K PSPOI D TMP
- D MCH D:$G(PSPOI) I $G(PSOUT) W ! S PSOUT=0,RESTART=1 K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to exit this option" D ^DIR K DIR I Y!(Y["^")!($D(DTOUT)) S PSOUT=1
- .S NEWFLAG=1 D DIR^PSSPOIM3 I $G(PSSDIR) W !!?3,"Now editing Orderable Item:",!?3,$P($G(^PS(50.7,PSPOI,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^") D INACT^PSSADDIT
- .K NEWFLAG,PSSDIR D EN^PSSPOIDT(PSPOI) K PSPOI
- I $G(RESTART),'$G(PSOUT) G START
- Q
- 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),$G(DOSEFV)'=0 S DA=$P($G(OTH),"^"),K=$P($G(OTH),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSA=X I $G(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)) W ! K DIR S DIR(0)="E" D ^DIR I 'Y!($D(DTOUT)) S PSOUT=1 Q
- I $O(^TMP($J,"PSSOO",0)) D OTHER,DISP
- Q:$G(PSOUT) I $O(^TMP($J,"PSSOO",0)),$G(MATCH) S PSSP=MATCH D ^PSSPOIM1 I PSOUT!(PSNO) S PSOUT=1 Q
- I $O(^TMP($J,"PSSOO",0)),$G(MATCH) K DIE S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_MATCH D ^DIE S PSPOI=MATCH D COM Q
- MCHA W ! I $G(DOSEFORM)'="" W !?3,"Dose Form -> ",DOSEFORM,!! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Match to another Orderable Item with same Dose Form" D ^DIR G:Y=1 LOOK I Y["^"!(Y="")!($D(DTOUT)) S PSOUT=1 Q
- I $G(DOSEFORM)="" K DIC S DIC="^PS(50.606,",DIC(0)="QEAMZ",DIC("A")="Choose Dose Form: " D ^DIC I $D(DTOUT)!($D(DUOUT))!(Y<1) S PSOUT=1 Q
- I $G(DOSEFORM)="" 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 Dose Form" D ^DIR
- I $G(DOSEFORM)="" S DOSEFORM=$P(^PS(50.606,DOSEPTR,0),"^") G:Y>0 LOOK I $D(DTOUT)!($D(DUOUT))!(Y<0) S PSOUT=1 Q
- MCHAN W !! I $L(VAGEN)>40 W !,"VA Generic Name -> ",VAGEN,!
- W !,?3,"Dose 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 I $D(DUOUT)!($D(DTOUT))!(Y["^")!(Y="") S PSOUT=1 Q
- I X[""""!($A(X)=45)!('(X'?1P.E))!(X?2"z".E) W $C(7),!!?5,"??" G MCHAN
- S X=Y,SPHOLD=X,(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 PSPOI=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 D:Y<1 G:(Y<1) MCHAN S NEWSP=+Y,DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_NEWSP D ^DIE D COM Q
- .W $C(7),!?5,"Unable to create entry, try again!",!! Q
- Q
- LOOK W !!!?3,"Enter ?? for Pharmacy Orderable Item List!"
- W ! 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 K DIC("S") S (NEWSP,PSSP)=+Y D ^PSSPOIM1 G:PSNO LOOK Q:PSOUT S DIE="^PSDRUG(",DA=PSIEN,DR="2.1////"_NEWSP D ^DIE 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
- S PSOUT=1 Q
- COM W !,"Match Complete!",! S:'$G(PSPOI) PSPOI=$G(NEWSP) Q
- OTHER W @IOF W !,"There are other Dispense Drugs with the same VA Generic Name and same Dose",!,"Form already matched to orderable items. Choose a number to match, or enter",!,"'^' to enter a new one.",!!?6,"Disp. drug -> ",PSNAME,! Q
- WOOPS W:$D(^TMP("PSSLOOP")) !!,$C(7),"Sorry, but someone else is using this option.",!
- Q
- PSSPOIM2 ;BIR/RTR/WRT-Orderable Item manual create - initial create ; 09/01/98 7:12
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
- +2 DO WOOPS
- HANG 2
- IF $DATA(^TMP("PSSLOOP"))
- QUIT
- +3 SET PSSITE=+$ORDER(^PS(59.7,0))
- IF $PIECE($GET(^PS(59.7,PSSITE,80)),"^",2)'=2
- WRITE !!?3,$SELECT($PIECE($GET(^(80)),"^",2)<2:"Orderable Item Auto-Create has not been completed!",1:"Manual matching process complete!"),!!
- KILL PSSITE
- Begin DoDot:1
- +4 KILL DIR
- SET DIR("A")="Press RETURN to continue"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- End DoDot:1
- QUIT
- +5 SET PSOUT=0
- DO MESSZ^PSSPOIM1
- IF $GET(PSOUT)
- GOTO CHECK
- +6 SET PSCREATE=1
- DO ^PSSPOIM3
- IF $GET(PSOOOUT)
- GOTO CHECK
- BEG ;
- +1 WRITE !!?3,"NOW MATCHING DISPENSE DRUGS!",!
- +2 SET X1=DT
- SET X2=-365
- DO C^%DTC
- SET PSXDATE=X
- SET PSOUT=0
- SET AAA=""
- +3 FOR
- SET AAA=$ORDER(^PSDRUG("B",AAA))
- IF AAA=""!($GET(PSOUT))
- QUIT
- FOR PSIEN=0:0
- SET PSIEN=$ORDER(^PSDRUG("B",AAA,PSIEN))
- IF 'PSIEN!($GET(PSOUT))
- QUIT
- IF $GET(PSIEN)
- IF '$PIECE($GET(^PSDRUG(PSIEN,2)),"^")
- Begin DoDot:1
- +4 SET APLU=$PIECE($GET(^PSDRUG(PSIEN,2)),"^",3)
- +5 SET ZXX=1
- SET PSXDDATE=+$PIECE($GET(^PSDRUG(PSIEN,"I")),"^")
- IF PSXDDATE
- IF PSXDDATE<PSXDATE
- SET ZXX=0
- End DoDot:1
- IF ZXX
- IF APLU["I"!(APLU["O")!(APLU["U")
- SET PSNAME=$PIECE(^(0),"^")
- DO START
- CHECK DO CHECK^PSSPOIM1
- +1 GOTO END^PSSPOIM1
- START KILL DOSEFV,DOSEFORM,POINT,SPHOLD,NEWSP,RESTART
- WRITE !!!?5,"Dispense Drug -> ",PSNAME
- +1 SET NODE=$GET(^PSDRUG(PSIEN,"ND"))
- SET DOSEPTR=0
- SET DA=$PIECE($GET(NODE),"^")
- SET X=$$VAGN^PSNAPIS(DA)
- SET VAGEN=X
- IF +$PIECE(NODE,"^")
- IF +$PIECE(NODE,"^",3)
- IF $GET(VAGEN)'=0
- SET K=$PIECE($GET(NODE),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET DOSEFV=X
- IF $GET(DOSEFV)'=0
- Begin DoDot:1
- +2 SET DOSEPTR=$PIECE(X,"^")
- SET DOSEFORM=$PIECE(X,"^",2)
- End DoDot:1
- +3 KILL PSPOI
- DO TMP
- +4 DO MCH
- IF $GET(PSPOI)
- Begin DoDot:1
- +5 SET NEWFLAG=1
- DO DIR^PSSPOIM3
- IF $GET(PSSDIR)
- WRITE !!?3,"Now editing Orderable Item:",!?3,$PIECE($GET(^PS(50.7,PSPOI,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")
- DO INACT^PSSADDIT
- +6 KILL NEWFLAG,PSSDIR
- DO EN^PSSPOIDT(PSPOI)
- KILL PSPOI
- End DoDot:1
- IF $GET(PSOUT)
- WRITE !
- SET PSOUT=0
- SET RESTART=1
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Do you want to exit this option"
- DO ^DIR
- KILL DIR
- IF Y!(Y["^")!($DATA(DTOUT))
- SET PSOUT=1
- +7 IF $GET(RESTART)
- IF '$GET(PSOUT)
- GOTO START
- +8 QUIT
- 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 $GET(DOSEFV)'=0
- SET DA=$PIECE($GET(OTH),"^")
- SET K=$PIECE($GET(OTH),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET DOSA=X
- IF $GET(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))
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y!($DATA(DTOUT))
- SET PSOUT=1
- QUIT
- +1 IF $ORDER(^TMP($JOB,"PSSOO",0))
- DO OTHER
- DO DISP
- +2 IF $GET(PSOUT)
- QUIT
- IF $ORDER(^TMP($JOB,"PSSOO",0))
- IF $GET(MATCH)
- SET PSSP=MATCH
- DO ^PSSPOIM1
- IF PSOUT!(PSNO)
- SET PSOUT=1
- QUIT
- +3 IF $ORDER(^TMP($JOB,"PSSOO",0))
- IF $GET(MATCH)
- KILL DIE
- SET DIE="^PSDRUG("
- SET DA=PSIEN
- SET DR="2.1////"_MATCH
- DO ^DIE
- SET PSPOI=MATCH
- DO COM
- QUIT
- MCHA WRITE !
- IF $GET(DOSEFORM)'=""
- WRITE !?3,"Dose Form -> ",DOSEFORM,!!
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Match to another Orderable Item with same Dose Form"
- DO ^DIR
- IF Y=1
- GOTO LOOK
- IF Y["^"!(Y="")!($DATA(DTOUT))
- SET PSOUT=1
- QUIT
- +1 IF $GET(DOSEFORM)=""
- KILL DIC
- SET DIC="^PS(50.606,"
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Choose Dose Form: "
- DO ^DIC
- IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<1)
- SET PSOUT=1
- QUIT
- +2 IF $GET(DOSEFORM)=""
- SET DOSEPTR=+Y
- WRITE !!?3,"Dose Form -> ",$GET(Y(0,0))
- +3 IF $GET(DOSEFORM)=""
- KILL DIR
- WRITE !
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Match to another Orderable Item with same Dose Form"
- DO ^DIR
- +4 IF $GET(DOSEFORM)=""
- SET DOSEFORM=$PIECE(^PS(50.606,DOSEPTR,0),"^")
- IF Y>0
- GOTO LOOK
- IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<0)
- SET PSOUT=1
- QUIT
- MCHAN WRITE !!
- IF $LENGTH(VAGEN)>40
- WRITE !,"VA Generic Name -> ",VAGEN,!
- +1 WRITE !,?3,"Dose 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="")
- SET PSOUT=1
- QUIT
- +4 IF X[""""!($ASCII(X)=45)!('(X'?1P.E))!(X?2"z".E)
- WRITE $CHAR(7),!!?5,"??"
- GOTO MCHAN
- +5 SET X=Y
- SET SPHOLD=X
- 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 PSPOI=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
- DO ^PSSPOIM1
- 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
- IF Y<1
- Begin DoDot:1
- +11 WRITE $CHAR(7),!?5,"Unable to create entry, try again!",!!
- 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
- DO COM
- QUIT
- +12 QUIT
- LOOK WRITE !!!?3,"Enter ?? for Pharmacy Orderable Item List!"
- +1 WRITE !
- 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
- KILL DIC("S")
- 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
- 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 SET PSOUT=1
- QUIT
- COM WRITE !,"Match Complete!",!
- IF '$GET(PSPOI)
- SET PSPOI=$GET(NEWSP)
- QUIT
- OTHER WRITE @IOF
- WRITE !,"There are other Dispense Drugs with the same VA Generic Name and same Dose",!,"Form already matched to orderable items. Choose a number to match, or enter",!,"'^' to enter a new one.",!!?6,"Disp. drug -> ",PSNAME,!
- QUIT
- WOOPS IF $DATA(^TMP("PSSLOOP"))
- WRITE !!,$CHAR(7),"Sorry, but someone else is using this option.",!
- +1 QUIT
