PSOERCR1 ;BHAM/MR - eRx Change Request Functionality - Add Drug ; 11/14/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**746,769**;DEC 1997;Build 26
;
; Add New Medication Suggestion for Change Request
; Input: ERXIEN - Pointer the ERX HOLDING QUEUE file (#52.49)
;Output:
;
EN ; Add Medication Suggestion to eRx Change Request Entry point
N DIC,DIR,DIRUT,DIROUT,DUOUT,X,Y,I,J,MPIEN,MPIENS,ERXDRUG,DRUGTYPE,DRUGCODE,DRUGCODQ,DRUG,DAYSSUP,SUBS
N QTY,QTYQUAL,QTYUM,NUMREFS,MRC,MRCO,CODE,DWLW,DWPK,DWDISABL,DIWESUB,TXTLEN,X,QUIT,PSOQUIT,FINISH
;
I '$G(CRMED) S CRMED=$O(CRMEDS(99),-1)+1
D LOADMED
;
DRUG ; Use eRx OR VistA drug?
; W !!,"eRx Drug: "_ERXDRUG,!
S DIR(0)="S^E:USE ERX DRUG;V:CHOOSE A VISTA DRUG"
S DIR("A")="DRUG SELECTION" I $G(DRUGTYPE)'="" S DIR("B")=DRUGTYPE
D ^DIR I $D(DIRUT)!$D(DIROUT) W ! G @$$GOTO(X,"DRUG")
I Y="V",$G(DRUGTYPE)="E" S (DRUG,DRUGCODE,DRUGCODQ)=""
S DRUGTYPE=Y
K DIC,DUOUT S QUIT=0
I DRUGTYPE="E" D
. I $P($G(CRMEDS(+CRMED)),"^")'="V" D
. . D LOADMED
. E D
. . S DRUG=$$GET1^DIQ(52.49,ERXIEN,3.1)
. . S DRUGCODE=$$GET1^DIQ(52.49,ERXIEN,4.1)
. . S DRUGCODQ=$$GET1^DIQ(52.49,ERXIEN,4.2)
. W !!,"eRx Drug: ",DRUG," ",$S(DRUGCODQ="ND":"NDC",1:"UPN")_": ",DRUGCODE,!
E D W ! G EXIT:$G(QUIT) I X["^" G @$$GOTO(X,"DRUG")
. I DRUGTYPE="E" K DRUG,DRUGCODE,DRUGCODQ
. W ! S DIC(0)="AEMQ",DIC=50 I $G(DRUG)'="" S DIC("B")=DRUG
. S DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y))"
. S FINISH=0
. F D ^DIC D I FINISH!QUIT Q
. . I X="^"!(X["^"&($$GOTO(X,"DRUG")'["?")) S QUIT=1 Q
. . I Y'>0 W !!,"VistA Drug is required",!,$C(7) Q
. . I $$GETNDC^PSSNDCUT(+Y,$G(PSOSITE))="" W !!,"VistA Drug is missing the NDC Code, please select a different drug.",!,$C(7) Q
. . S DRUG=$$GET1^DIQ(50,+Y,.01),DRUGCODE=$$GETNDC^PSSNDCUT(+Y,$G(PSOSITE)),DRUGCODQ="ND",FINISH=1
;
SUBS ; SUBSTITUTIONS? Prompt
K DIR S DIR(0)="SA^Y:YES;N:NO",DIR("A")="SUBSTITUTIONS? "
S DIR("B")="YES" I $G(SUBS) S DIR("B")="NO"
D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"SUBS")
S SUBS=$S(Y="Y":0,1:1) ;,$P(CRMEDS(CRMED),"^",5)=SUBS
;
QTY ; QUANTITY Prompt
K DIR S DIR(0)="NOA^1:99999",DIR("A")="QUANTITY: " I $G(QTY) S DIR("B")=QTY
D ^DIR
I X="" W !!,"Quantity is required!",!,$C(7) G QTY
I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"QTY")
S QTY=Y
;
QTYQUAL ; QTY QUALIFIER Prompt
K DIR S DIR(0)="SO^"
S CODE=0 F S CODE=$O(^PS(52.45,"TYPE","QCQ",CODE)) Q:'CODE D
. S DIR(0)=DIR(0)_$$GET1^DIQ(52.45,CODE,.01)_":"_$$GET1^DIQ(52.45,CODE,.02)_";"
S DIR("A")="QTY QUALIFIER",DIR("B")=38 I $G(QTYQUAL)'="" S DIR("B")=QTYQUAL
D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"QTYQUAL")
S QTYQUAL=Y ;,$P(CRMEDS(CRMED),"^",7)=QTYQUAL
;
QTYUM ; QTY UNIT OF MEASURE Prompt
K DIC S DIC("A")="QTY UNIT OF MEASURE: " I $G(QTYUM)'="" S DIC("B")=QTYUM
S DIC="^PS(52.45,",DIC(0)="AEMQ",DIC("S")="I $$CODES^PSOERXON(Y)"
D ^DIC I $D(DUOUT) G @$$GOTO(X,"QTYUM")
I X="" W !!,"Quantity Unit of Measure is required!",!,$C(7) G QTYUM
S MRC=Y,MRCO=$$GET1^DIQ(52.45,MRC,.01,"E")
I $G(MRC) S QTYUM=MRC_U_MRCO
S QTYUM=$P(Y,"^",2) ;,$P(CRMEDS(CRMED),"^",8)=QTYUM
;
DAYSSUP ; DAYS SUPPLY Prompt
K DIR S DIR(0)="NO^1:365",DIR("A")="DAYS SUPPLY" I $G(DAYSSUP) S DIR("B")=DAYSSUP
D ^DIR I $D(DIROUT) G @$$GOTO(X,"DAYSUP")
S DAYSSUP=Y
;
NUMREFS ; # OF REFILLS Prompt
K DIR S DIR(0)="NO^0:11",DIR("A")="# OF REFILLS" I $G(NUMREFS)'="" S DIR("B")=NUMREFS
D ^DIR I $D(DIROUT) G @$$GOTO(X,"NUMREFS")
I X="" W !!,"# of Refills is required.",! G NUMREFS
S NUMREFS=Y
;
SIG ; SIG Prompt
K DIC,DWLW,DWPK,DWDISABL,DIWESUB,SIGLEN,X,TXTLEN
S DIC="^TMP(""PSOCRSIG"""_",$J,"
S DWLW=70,DWPK=1,DWDISABL="P"
S DIWESUB="SIG Text"
W !,"SIG Text: " D EN^DIWE
S X=0 F S X=$O(^TMP("PSOCRSIG",$J,X)) Q:'X D
. S TXTLEN=$G(TXTLEN)+$L(^TMP("PSOCRSIG",$J,X,0))
I $G(TXTLEN)>1000 D G SIG
. W !,"Sig must be 1000 characters or less.",!
. D DIRE^PSOERXX1
;
NOTE ; NOTE TO PROVIDER Prompt
K DIR,DIRUT S DIR(0)="FO^1:210",DIR("A")="SUGGESTED PROVIDER NOTE (FOR RESPONSE RX)"
I $G(NOTE2PRV)'="" S DIR("B")=NOTE2PRV
S DIR("?")="This is the suggested Provider Note that will be sent back with Rx Response if this drug option is selected by the outside Provider. It may be edited/removed by the Provider before sending the response back."
D ^DIR I $D(DIROUT) G @$$GOTO(X,"NOTE")
S NOTE2PRV=Y
;
I $G(DRUG)="" W !,"Drug is Required!" G DRUG
I $G(SUBS)="" W !,"Substitution is Required!" G SUBS
I '$G(QTY) W !,"Quantity is Required!" G QTY
I $G(QTYQUAL)="" W !,"Quantity Qualifier is Required!" G QTYQUAL
I $G(QTYUM)="" W !,"Quantity Unit of Measure is Required!" G QTYUM
I $G(NUMREFS)="" W !,"Days Supply is Required!" G NUMREFS
;
W !?65,"Updating..."
K CRMEDS(CRMED)
S CRMEDS(CRMED)=DRUGTYPE_"^"_DRUG_"^"_DRUGCODE_"^"_DRUGCODQ_"^"_SUBS_"^"_QTY_"^"_QTYQUAL_"^"_QTYUM_"^"_DAYSSUP_"^"_NUMREFS
S CRMEDS(CRMED,"NOTE")=NOTE2PRV
M CRMEDS(CRMED,"SIG")=^TMP("PSOCRSIG",$J)
W "OK"
;
EXIT ; Quit
Q
;
LOADMED ; Load Default Values for an existing Medication Suggestion
N Z,MPIEN,MPIENS,ERXSIG
K ^TMP("PSOCRSIG",$J) S (DRUG,DRUGCODE,DRUGCODQ,SUBS,QTY,QTYQUAL,QTYUM,DAYSSUP,NOTE2PRV)=""
I $G(DRUGTYPE)="E" D
. S DRUG=$$GET1^DIQ(52.49,ERXIEN,3.1) I DRUG="" S DRUG=$$GETDRUG^PSOERXU5(ERXIEN)
. S DRUGCODE=$$GET1^DIQ(52.49,ERXIEN,4.1)
. S DRUGCODQ=$$GET1^DIQ(52.49,ERXIEN,4.2)
. S MPIEN=$O(^PS(52.49,ERXIEN,311,"C","P",0))
. I MPIEN D
. . S MPIENS=MPIEN_","_ERXIEN_","
. . S DRUG=$$GET1^DIQ(52.49311,MPIENS,.03)
. . S DRUGCODE=$$GET1^DIQ(52.49311,MPIENS,1.1)
. . S DRUGCODQ=$$GET1^DIQ(52.49311,MPIENS,1.2)
. . S X=$$GET1^DIQ(52.49311,MPIENS,8,,"ERXSIG")
. . F I=1:1 Q:'$D(ERXSIG(I)) S ^TMP("PSOCRSIG",$J,I,0)=ERXSIG(I)
. S QTY=$$GET1^DIQ(52.49,ERXIEN,5.1)
. S QTYQUAL=$$GET1^DIQ(52.49,ERXIEN,5.2,"I")
. S QTYUM=$$GET1^DIQ(52.49,ERXIEN,5.4)
. S DAYSSUP=$$GET1^DIQ(52.49,ERXIEN,5.5)
. S NUMREFS=$$GET1^DIQ(52.49,ERXIEN,5.6)
. ;S NOTE2PRV=$$GET1^DIQ(52.49,ERXIEN,8)
I '$G(CRMED)!'$D(CRMEDS(+$G(CRMED))) Q
; - Loading an existing entry
S Z=CRMEDS(CRMED),DRUGTYPE=$P(Z,"^")
I $G(DRUGTYPE)'="E" D
. S DRUG=$P(Z,"^",2)
. S DRUGCODE=$P(Z,"^",3)
. S DRUGCODQ=$P(Z,"^",4)
S SUBS=$P(Z,"^",5)
S QTY=$P(Z,"^",6)
S QTYQUAL=$P(Z,"^",7)
S QTYUM=$P(Z,"^",8)
S DAYSSUP=$P(Z,"^",9)
S NUMREFS=$P(Z,"^",10)
S NOTE2PRV=$G(CRMEDS(CRMED,"NOTE"))
M ^TMP("PSOCRSIG",$J)=CRMEDS(CRMED,"SIG")
Q
;
GOTO(INPUT,HOME) ; - Directed up-arrow
N GOTO,TAG,TRGT
I $P(INPUT,"^",2)="" S PSOQUIT=1 Q "EXIT"
;
S TRGT=$P(INPUT,"^",2)
S TAG("DRUG SELECTION")="EORV"
S TAG("DRUG")="DRUG"
S TAG("SUBSTITUTION")="SUBS"
S TAG("QUANTITY")="QTY"
S TAG("QTY QUALIFIER")="QTYQUAL"
S TAG("QTY UNIT OF MEASURE")="QTYUM"
S TAG("DAYS SUPPLY")="DAYSSUP"
S TAG("# OF REFILLS")="NUMREFS"
S TAG("SIG")="SIG"
S TAG("NOTE")="NOTE"
;
S GOTO=HOME
S TAG="" F S TAG=$O(TAG(TAG)) Q:TAG="" I $E(TAG,1,$L(TRGT))=TRGT S GOTO=TAG(TAG) Q
I GOTO=HOME W " ??",$C(7)
;
Q GOTO
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERCR1 7038 printed Nov 22, 2024@17:37:40 Page 2
PSOERCR1 ;BHAM/MR - eRx Change Request Functionality - Add Drug ; 11/14/2019 3:46pm
+1 ;;7.0;OUTPATIENT PHARMACY;**746,769**;DEC 1997;Build 26
+2 ;
+3 ; Add New Medication Suggestion for Change Request
+4 ; Input: ERXIEN - Pointer the ERX HOLDING QUEUE file (#52.49)
+5 ;Output:
+6 ;
EN ; Add Medication Suggestion to eRx Change Request Entry point
+1 NEW DIC,DIR,DIRUT,DIROUT,DUOUT,X,Y,I,J,MPIEN,MPIENS,ERXDRUG,DRUGTYPE,DRUGCODE,DRUGCODQ,DRUG,DAYSSUP,SUBS
+2 NEW QTY,QTYQUAL,QTYUM,NUMREFS,MRC,MRCO,CODE,DWLW,DWPK,DWDISABL,DIWESUB,TXTLEN,X,QUIT,PSOQUIT,FINISH
+3 ;
+4 IF '$GET(CRMED)
SET CRMED=$ORDER(CRMEDS(99),-1)+1
+5 DO LOADMED
+6 ;
DRUG ; Use eRx OR VistA drug?
+1 ; W !!,"eRx Drug: "_ERXDRUG,!
+2 SET DIR(0)="S^E:USE ERX DRUG;V:CHOOSE A VISTA DRUG"
+3 SET DIR("A")="DRUG SELECTION"
IF $GET(DRUGTYPE)'=""
SET DIR("B")=DRUGTYPE
+4 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
WRITE !
GOTO @$$GOTO(X,"DRUG")
+5 IF Y="V"
IF $GET(DRUGTYPE)="E"
SET (DRUG,DRUGCODE,DRUGCODQ)=""
+6 SET DRUGTYPE=Y
+7 KILL DIC,DUOUT
SET QUIT=0
+8 IF DRUGTYPE="E"
Begin DoDot:1
+9 IF $PIECE($GET(CRMEDS(+CRMED)),"^")'="V"
Begin DoDot:2
+10 DO LOADMED
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 SET DRUG=$$GET1^DIQ(52.49,ERXIEN,3.1)
+13 SET DRUGCODE=$$GET1^DIQ(52.49,ERXIEN,4.1)
+14 SET DRUGCODQ=$$GET1^DIQ(52.49,ERXIEN,4.2)
End DoDot:2
+15 WRITE !!,"eRx Drug: ",DRUG," ",$SELECT(DRUGCODQ="ND":"NDC",1:"UPN")_": ",DRUGCODE,!
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 IF DRUGTYPE="E"
KILL DRUG,DRUGCODE,DRUGCODQ
+18 WRITE !
SET DIC(0)="AEMQ"
SET DIC=50
IF $GET(DRUG)'=""
SET DIC("B")=DRUG
+19 SET DIC("S")="I $$ACTIVE^PSOERXA0(Y),($$OUTPAT^PSOERXA0(Y))"
+20 SET FINISH=0
+21 FOR
DO ^DIC
Begin DoDot:2
+22 IF X="^"!(X["^"&($$GOTO(X,"DRUG")'["?"))
SET QUIT=1
QUIT
+23 IF Y'>0
WRITE !!,"VistA Drug is required",!,$CHAR(7)
QUIT
+24 IF $$GETNDC^PSSNDCUT(+Y,$GET(PSOSITE))=""
WRITE !!,"VistA Drug is missing the NDC Code, please select a different drug.",!,$CHAR(7)
QUIT
+25 SET DRUG=$$GET1^DIQ(50,+Y,.01)
SET DRUGCODE=$$GETNDC^PSSNDCUT(+Y,$GET(PSOSITE))
SET DRUGCODQ="ND"
SET FINISH=1
End DoDot:2
IF FINISH!QUIT
QUIT
End DoDot:1
WRITE !
if $GET(QUIT)
GOTO EXIT
IF X["^"
GOTO @$$GOTO(X,"DRUG")
+26 ;
SUBS ; SUBSTITUTIONS? Prompt
+1 KILL DIR
SET DIR(0)="SA^Y:YES;N:NO"
SET DIR("A")="SUBSTITUTIONS? "
+2 SET DIR("B")="YES"
IF $GET(SUBS)
SET DIR("B")="NO"
+3 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"SUBS")
+4 ;,$P(CRMEDS(CRMED),"^",5)=SUBS
SET SUBS=$SELECT(Y="Y":0,1:1)
+5 ;
QTY ; QUANTITY Prompt
+1 KILL DIR
SET DIR(0)="NOA^1:99999"
SET DIR("A")="QUANTITY: "
IF $GET(QTY)
SET DIR("B")=QTY
+2 DO ^DIR
+3 IF X=""
WRITE !!,"Quantity is required!",!,$CHAR(7)
GOTO QTY
+4 IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"QTY")
+5 SET QTY=Y
+6 ;
QTYQUAL ; QTY QUALIFIER Prompt
+1 KILL DIR
SET DIR(0)="SO^"
+2 SET CODE=0
FOR
SET CODE=$ORDER(^PS(52.45,"TYPE","QCQ",CODE))
if 'CODE
QUIT
Begin DoDot:1
+3 SET DIR(0)=DIR(0)_$$GET1^DIQ(52.45,CODE,.01)_":"_$$GET1^DIQ(52.45,CODE,.02)_";"
End DoDot:1
+4 SET DIR("A")="QTY QUALIFIER"
SET DIR("B")=38
IF $GET(QTYQUAL)'=""
SET DIR("B")=QTYQUAL
+5 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
GOTO @$$GOTO(X,"QTYQUAL")
+6 ;,$P(CRMEDS(CRMED),"^",7)=QTYQUAL
SET QTYQUAL=Y
+7 ;
QTYUM ; QTY UNIT OF MEASURE Prompt
+1 KILL DIC
SET DIC("A")="QTY UNIT OF MEASURE: "
IF $GET(QTYUM)'=""
SET DIC("B")=QTYUM
+2 SET DIC="^PS(52.45,"
SET DIC(0)="AEMQ"
SET DIC("S")="I $$CODES^PSOERXON(Y)"
+3 DO ^DIC
IF $DATA(DUOUT)
GOTO @$$GOTO(X,"QTYUM")
+4 IF X=""
WRITE !!,"Quantity Unit of Measure is required!",!,$CHAR(7)
GOTO QTYUM
+5 SET MRC=Y
SET MRCO=$$GET1^DIQ(52.45,MRC,.01,"E")
+6 IF $GET(MRC)
SET QTYUM=MRC_U_MRCO
+7 ;,$P(CRMEDS(CRMED),"^",8)=QTYUM
SET QTYUM=$PIECE(Y,"^",2)
+8 ;
DAYSSUP ; DAYS SUPPLY Prompt
+1 KILL DIR
SET DIR(0)="NO^1:365"
SET DIR("A")="DAYS SUPPLY"
IF $GET(DAYSSUP)
SET DIR("B")=DAYSSUP
+2 DO ^DIR
IF $DATA(DIROUT)
GOTO @$$GOTO(X,"DAYSUP")
+3 SET DAYSSUP=Y
+4 ;
NUMREFS ; # OF REFILLS Prompt
+1 KILL DIR
SET DIR(0)="NO^0:11"
SET DIR("A")="# OF REFILLS"
IF $GET(NUMREFS)'=""
SET DIR("B")=NUMREFS
+2 DO ^DIR
IF $DATA(DIROUT)
GOTO @$$GOTO(X,"NUMREFS")
+3 IF X=""
WRITE !!,"# of Refills is required.",!
GOTO NUMREFS
+4 SET NUMREFS=Y
+5 ;
SIG ; SIG Prompt
+1 KILL DIC,DWLW,DWPK,DWDISABL,DIWESUB,SIGLEN,X,TXTLEN
+2 SET DIC="^TMP(""PSOCRSIG"""_",$J,"
+3 SET DWLW=70
SET DWPK=1
SET DWDISABL="P"
+4 SET DIWESUB="SIG Text"
+5 WRITE !,"SIG Text: "
DO EN^DIWE
+6 SET X=0
FOR
SET X=$ORDER(^TMP("PSOCRSIG",$JOB,X))
if 'X
QUIT
Begin DoDot:1
+7 SET TXTLEN=$GET(TXTLEN)+$LENGTH(^TMP("PSOCRSIG",$JOB,X,0))
End DoDot:1
+8 IF $GET(TXTLEN)>1000
Begin DoDot:1
+9 WRITE !,"Sig must be 1000 characters or less.",!
+10 DO DIRE^PSOERXX1
End DoDot:1
GOTO SIG
+11 ;
NOTE ; NOTE TO PROVIDER Prompt
+1 KILL DIR,DIRUT
SET DIR(0)="FO^1:210"
SET DIR("A")="SUGGESTED PROVIDER NOTE (FOR RESPONSE RX)"
+2 IF $GET(NOTE2PRV)'=""
SET DIR("B")=NOTE2PRV
+3 SET DIR("?")="This is the suggested Provider Note that will be sent back with Rx Response if this drug option is selected by the outside Provider. It may be edited/removed by the Provider before sending the response back."
+4 DO ^DIR
IF $DATA(DIROUT)
GOTO @$$GOTO(X,"NOTE")
+5 SET NOTE2PRV=Y
+6 ;
+7 IF $GET(DRUG)=""
WRITE !,"Drug is Required!"
GOTO DRUG
+8 IF $GET(SUBS)=""
WRITE !,"Substitution is Required!"
GOTO SUBS
+9 IF '$GET(QTY)
WRITE !,"Quantity is Required!"
GOTO QTY
+10 IF $GET(QTYQUAL)=""
WRITE !,"Quantity Qualifier is Required!"
GOTO QTYQUAL
+11 IF $GET(QTYUM)=""
WRITE !,"Quantity Unit of Measure is Required!"
GOTO QTYUM
+12 IF $GET(NUMREFS)=""
WRITE !,"Days Supply is Required!"
GOTO NUMREFS
+13 ;
+14 WRITE !?65,"Updating..."
+15 KILL CRMEDS(CRMED)
+16 SET CRMEDS(CRMED)=DRUGTYPE_"^"_DRUG_"^"_DRUGCODE_"^"_DRUGCODQ_"^"_SUBS_"^"_QTY_"^"_QTYQUAL_"^"_QTYUM_"^"_DAYSSUP_"^"_NUMREFS
+17 SET CRMEDS(CRMED,"NOTE")=NOTE2PRV
+18 MERGE CRMEDS(CRMED,"SIG")=^TMP("PSOCRSIG",$JOB)
+19 WRITE "OK"
+20 ;
EXIT ; Quit
+1 QUIT
+2 ;
LOADMED ; Load Default Values for an existing Medication Suggestion
+1 NEW Z,MPIEN,MPIENS,ERXSIG
+2 KILL ^TMP("PSOCRSIG",$JOB)
SET (DRUG,DRUGCODE,DRUGCODQ,SUBS,QTY,QTYQUAL,QTYUM,DAYSSUP,NOTE2PRV)=""
+3 IF $GET(DRUGTYPE)="E"
Begin DoDot:1
+4 SET DRUG=$$GET1^DIQ(52.49,ERXIEN,3.1)
IF DRUG=""
SET DRUG=$$GETDRUG^PSOERXU5(ERXIEN)
+5 SET DRUGCODE=$$GET1^DIQ(52.49,ERXIEN,4.1)
+6 SET DRUGCODQ=$$GET1^DIQ(52.49,ERXIEN,4.2)
+7 SET MPIEN=$ORDER(^PS(52.49,ERXIEN,311,"C","P",0))
+8 IF MPIEN
Begin DoDot:2
+9 SET MPIENS=MPIEN_","_ERXIEN_","
+10 SET DRUG=$$GET1^DIQ(52.49311,MPIENS,.03)
+11 SET DRUGCODE=$$GET1^DIQ(52.49311,MPIENS,1.1)
+12 SET DRUGCODQ=$$GET1^DIQ(52.49311,MPIENS,1.2)
+13 SET X=$$GET1^DIQ(52.49311,MPIENS,8,,"ERXSIG")
+14 FOR I=1:1
if '$DATA(ERXSIG(I))
QUIT
SET ^TMP("PSOCRSIG",$JOB,I,0)=ERXSIG(I)
End DoDot:2
+15 SET QTY=$$GET1^DIQ(52.49,ERXIEN,5.1)
+16 SET QTYQUAL=$$GET1^DIQ(52.49,ERXIEN,5.2,"I")
+17 SET QTYUM=$$GET1^DIQ(52.49,ERXIEN,5.4)
+18 SET DAYSSUP=$$GET1^DIQ(52.49,ERXIEN,5.5)
+19 SET NUMREFS=$$GET1^DIQ(52.49,ERXIEN,5.6)
+20 ;S NOTE2PRV=$$GET1^DIQ(52.49,ERXIEN,8)
End DoDot:1
+21 IF '$GET(CRMED)!'$DATA(CRMEDS(+$GET(CRMED)))
QUIT
+22 ; - Loading an existing entry
+23 SET Z=CRMEDS(CRMED)
SET DRUGTYPE=$PIECE(Z,"^")
+24 IF $GET(DRUGTYPE)'="E"
Begin DoDot:1
+25 SET DRUG=$PIECE(Z,"^",2)
+26 SET DRUGCODE=$PIECE(Z,"^",3)
+27 SET DRUGCODQ=$PIECE(Z,"^",4)
End DoDot:1
+28 SET SUBS=$PIECE(Z,"^",5)
+29 SET QTY=$PIECE(Z,"^",6)
+30 SET QTYQUAL=$PIECE(Z,"^",7)
+31 SET QTYUM=$PIECE(Z,"^",8)
+32 SET DAYSSUP=$PIECE(Z,"^",9)
+33 SET NUMREFS=$PIECE(Z,"^",10)
+34 SET NOTE2PRV=$GET(CRMEDS(CRMED,"NOTE"))
+35 MERGE ^TMP("PSOCRSIG",$JOB)=CRMEDS(CRMED,"SIG")
+36 QUIT
+37 ;
GOTO(INPUT,HOME) ; - Directed up-arrow
+1 NEW GOTO,TAG,TRGT
+2 IF $PIECE(INPUT,"^",2)=""
SET PSOQUIT=1
QUIT "EXIT"
+3 ;
+4 SET TRGT=$PIECE(INPUT,"^",2)
+5 SET TAG("DRUG SELECTION")="EORV"
+6 SET TAG("DRUG")="DRUG"
+7 SET TAG("SUBSTITUTION")="SUBS"
+8 SET TAG("QUANTITY")="QTY"
+9 SET TAG("QTY QUALIFIER")="QTYQUAL"
+10 SET TAG("QTY UNIT OF MEASURE")="QTYUM"
+11 SET TAG("DAYS SUPPLY")="DAYSSUP"
+12 SET TAG("# OF REFILLS")="NUMREFS"
+13 SET TAG("SIG")="SIG"
+14 SET TAG("NOTE")="NOTE"
+15 ;
+16 SET GOTO=HOME
+17 SET TAG=""
FOR
SET TAG=$ORDER(TAG(TAG))
if TAG=""
QUIT
IF $EXTRACT(TAG,1,$LENGTH(TRGT))=TRGT
SET GOTO=TAG(TAG)
QUIT
+18 IF GOTO=HOME
WRITE " ??",$CHAR(7)
+19 ;
+20 QUIT GOTO
