- PSOOREDX ;BIR/MHA-Rxs dosing common calls ;03/06/03
- ;;7.0;OUTPATIENT PHARMACY;**133,362,313**;DEC 1997;Build 76
- ;External reference to PS(51.2 supported by DBIA 2226
- ;called from psoored4 & psoored5
- VER D KV S DIR(0)="52.0113,8"
- S:$G(PSORXED("VERB",ENT))]"" DIR("B")=PSORXED("VERB",ENT)
- D ^DIR Q
- DUPD ;
- D KV S DIR(0)="52.0113,1",DIR("A")="DISPENSE UNITS PER DOSE"_$S($G(PSORXED("NOUN",ENT))]"":"("_PSORXED("NOUN",ENT)_")",1:"")
- I '$G(PSORXED("DOSE",ENT)),$G(PSORXED("DOSE",ENT-1)) S PSORXED("DOSE",ENT)=PSORXED("DOSE",ENT-1)
- Q
- ;
- STR S:+STRE>0&(X>0) PSORXED("DOSE",ENT)=(X*STRE) W !,"Dosage Ordered: "_$S($E(PSORXED("DOSE",ENT),1)=".":"0",1:"")_PSORXED("DOSE",ENT)_UNITN,!
- S:X'="" (PSORXED("DOSE ORDERED",ENT),DUPD)=X
- Q
- ;
- NOU D KV S DIR(0)="52.0113,3"
- S DIR("B")=$S($G(NOUN)]"":NOUN,1:$G(PSORXED("NOUN",ENT))) K:DIR("B")="" DIR("B")
- S PSONDEF=$G(DIR("B"))
- D ^DIR Q
- ;*313
- DUR1 I X="@" K DUR,PSORXED("DURATION",ENT) S:'$G(COPY) PSOSIGFL=1 ;*362 - create new order in CPRS
- I Y'="" S PSORXED("DURATION",ENT)=Y W " ("_$S(Y["L":"MONTHS",Y["W":"WEEKS",Y["H":"HOURS",Y["M":"MINUTES",1:"DAYS")_")"
- Q
- ;
- CON D KV S DIR(0)="52.0113,5"
- S:$G(PSORXED("CONJUNCTION",ENT))'="" DIR("B")=PSORXED("CONJUNCTION",ENT)
- D ^DIR Q
- ;
- CON1 D KV S DIR(0)="Y",DIR("A",1)="Deleting this conjunction will delete the dosing sequence that follows!"
- S DIR("A")="Are you sure you want to delete",DIR("B")="NO" D ^DIR
- Q
- ;
- KV K DIR,DIRUT,DTOUT,DUOUT Q
- ;
- ;
- FNM S NM=$E(X,2,4),NM=$TR(NM,"qwertyuioplkjhgfdsazxcvbnm","QWERTYUIOPLKJHGFDSAZXCVBNM")
- S FLDNM=$S(NM="DOS":"DOSE^*Dosage",NM="DIS":"DOSE ORDERED^Dispense Units",NM="ROU":"ROUTE^*Route",NM="SCH":"SCHEDULE^*Schedule",NM="DUR"!(NM="LIM"):"DURATION^*Duration",1:"")
- S:FLDNM="" FLDNM=$S(NM="CON":"CONJUNCTION^*Conjunction",NM="NOU":"NOUN^Noun",NM="VER":"VERB^Verb",1:"")
- Q
- JFN K FLDNM,AR S ENT=+Y,FLDNM=$S(NM="NOU":"NOU",NM="VER":"VER",NM="DOS":"ASK",NM="DIS":"DUPD",NM="ROU":"RTE",NM="SCH":"SCH",NM="DUR"!(NM="LIM"):"DUR",NM="CON":"CON",1:"")
- Q
- JP2 F AR=1:1:PSORXED("ENT") D:$G(PSORXED("SCHEDULE",AR))]""
- .W !,AR_". "_$P(FLDNM,"^",2)_": "_$S(NM="ROU"&($G(PSORXED($P(FLDNM,"^"),AR))):$P(^PS(51.2,PSORXED($P(FLDNM,"^"),AR),0),"^"),1:$G(PSORXED($P(FLDNM,"^"),AR))) S AR1=AR
- Q
- UPD ;updates dosing array
- K PSORXED("CONJUNCTION",ENT) S I=ENT+1 D RV
- S HENT=ENT
- UPD1 ;
- S I=HENT+1,J=I+1
- I $G(PSORXED("CONJUNCTION",I))]"",'$D(PSORXED("DOSE",J)) K PSORXED("CONJUNCTION",I) Q
- I $G(PSORXED("CONJUNCTION",I))]"" S PSORXED("CONJUNCTION",HENT)=PSORXED("CONJUNCTION",I) D G UPD1
- .K PSORXED("CONJUNCTION",I) I $D(PSORXED("DOSE",J)) D
- ..S PSORXED("DOSE",I)=PSORXED("DOSE",J)
- ..S PSORXED("DOSE ORDERED",I)=$G(PSORXED("DOSE ORDERED",J))
- ..S PSORXED("UNITS",I)=$G(PSORXED("UNITS",J))
- ..S PSORXED("NOUN",I)=$G(PSORXED("NOUN",J))
- ..S PSORXED("VERB",I)=$G(PSORXED("VERB",J))
- ..S PSORXED("DURATION",I)=$G(PSORXED("DURATION",J))
- ..S PSORXED("CONJUNCTION",I)=$G(PSORXED("CONJUNCTION",J))
- ..S PSORXED("ROUTE",I)=$G(PSORXED("ROUTE",J))
- ..S PSORXED("SCHEDULE",I)=$G(PSORXED("SCHEDULE",J))
- ..S PSORXED("ODOSE",I)=$G(PSORXED("ODOSE",J))
- ..S HENT=HENT+1,I=HENT+1
- ..I $G(PSORXED("CONJUNCTION",I))]"" Q
- ..K PSORXED("CONJUNCTION",I) D RV
- S PSORXED("ENT")=HENT K HENT D EN^PSOFSIG(.PSORXED)
- Q
- RV K PSORXED("UNITS",I),PSORXED("NOUN",I),PSORXED("DURATION",I),PSORXED("ROUTE",I),PSORXED("SCHEDULE",I),PSORXED("DOSE",I),PSORXED("DOSE ORDERED",I),PSORXED("VERB",I),PSORXED("ODOSE",I)
- Q
- M1 S VALMSG="Prescription Not Updated!"
- Q
- M2 S VALMSG="This edit will create a new prescription!"
- Q
- M3 S VALMSG=$S($G(COPY):"Copy Request Cancelled!",1:"Prescription Not Updated!")
- Q
- MP1 S VALMSG="Pending Order Not Updated!"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOOREDX 3723 printed Jan 18, 2025@03:33:06 Page 2
- PSOOREDX ;BIR/MHA-Rxs dosing common calls ;03/06/03
- +1 ;;7.0;OUTPATIENT PHARMACY;**133,362,313**;DEC 1997;Build 76
- +2 ;External reference to PS(51.2 supported by DBIA 2226
- +3 ;called from psoored4 & psoored5
- VER DO KV
- SET DIR(0)="52.0113,8"
- +1 if $GET(PSORXED("VERB",ENT))]""
- SET DIR("B")=PSORXED("VERB",ENT)
- +2 DO ^DIR
- QUIT
- DUPD ;
- +1 DO KV
- SET DIR(0)="52.0113,1"
- SET DIR("A")="DISPENSE UNITS PER DOSE"_$SELECT($GET(PSORXED("NOUN",ENT))]"":"("_PSORXED("NOUN",ENT)_")",1:"")
- +2 IF '$GET(PSORXED("DOSE",ENT))
- IF $GET(PSORXED("DOSE",ENT-1))
- SET PSORXED("DOSE",ENT)=PSORXED("DOSE",ENT-1)
- +3 QUIT
- +4 ;
- STR if +STRE>0&(X>0)
- SET PSORXED("DOSE",ENT)=(X*STRE)
- WRITE !,"Dosage Ordered: "_$SELECT($EXTRACT(PSORXED("DOSE",ENT),1)=".":"0",1:"")_PSORXED("DOSE",ENT)_UNITN,!
- +1 if X'=""
- SET (PSORXED("DOSE ORDERED",ENT),DUPD)=X
- +2 QUIT
- +3 ;
- NOU DO KV
- SET DIR(0)="52.0113,3"
- +1 SET DIR("B")=$SELECT($GET(NOUN)]"":NOUN,1:$GET(PSORXED("NOUN",ENT)))
- if DIR("B")=""
- KILL DIR("B")
- +2 SET PSONDEF=$GET(DIR("B"))
- +3 DO ^DIR
- QUIT
- +4 ;*313
- DUR1 ;*362 - create new order in CPRS
- IF X="@"
- KILL DUR,PSORXED("DURATION",ENT)
- if '$GET(COPY)
- SET PSOSIGFL=1
- +1 IF Y'=""
- SET PSORXED("DURATION",ENT)=Y
- WRITE " ("_$SELECT(Y["L":"MONTHS",Y["W":"WEEKS",Y["H":"HOURS",Y["M":"MINUTES",1:"DAYS")_")"
- +2 QUIT
- +3 ;
- CON DO KV
- SET DIR(0)="52.0113,5"
- +1 if $GET(PSORXED("CONJUNCTION",ENT))'=""
- SET DIR("B")=PSORXED("CONJUNCTION",ENT)
- +2 DO ^DIR
- QUIT
- +3 ;
- CON1 DO KV
- SET DIR(0)="Y"
- SET DIR("A",1)="Deleting this conjunction will delete the dosing sequence that follows!"
- +1 SET DIR("A")="Are you sure you want to delete"
- SET DIR("B")="NO"
- DO ^DIR
- +2 QUIT
- +3 ;
- KV KILL DIR,DIRUT,DTOUT,DUOUT
- QUIT
- +1 ;
- +2 ;
- FNM SET NM=$EXTRACT(X,2,4)
- SET NM=$TRANSLATE(NM,"qwertyuioplkjhgfdsazxcvbnm","QWERTYUIOPLKJHGFDSAZXCVBNM")
- +1 SET FLDNM=$SELECT(NM="DOS":"DOSE^*Dosage",NM="DIS":"DOSE ORDERED^Dispense Units",NM="ROU":"ROUTE^*Route",NM="SCH":"SCHEDULE^*Schedule",NM="DUR"!(NM="LIM"):"DURATION^*Duration",1:"")
- +2 if FLDNM=""
- SET FLDNM=$SELECT(NM="CON":"CONJUNCTION^*Conjunction",NM="NOU":"NOUN^Noun",NM="VER":"VERB^Verb",1:"")
- +3 QUIT
- JFN KILL FLDNM,AR
- SET ENT=+Y
- SET FLDNM=$SELECT(NM="NOU":"NOU",NM="VER":"VER",NM="DOS":"ASK",NM="DIS":"DUPD",NM="ROU":"RTE",NM="SCH":"SCH",NM="DUR"!(NM="LIM"):"DUR",NM="CON":"CON",1:"")
- +1 QUIT
- JP2 FOR AR=1:1:PSORXED("ENT")
- if $GET(PSORXED("SCHEDULE",AR))]""
- Begin DoDot:1
- +1 WRITE !,AR_". "_$PIECE(FLDNM,"^",2)_": "_$SELECT(NM="ROU"&($GET(PSORXED($PIECE(FLDNM,"^"),AR))):$PIECE(^PS(51.2,PSORXED($PIECE(FLDNM,"^"),AR),0),"^"),1:$GET(PSORXED($PIECE(FLDNM,"^"),AR)))
- SET AR1=AR
- End DoDot:1
- +2 QUIT
- UPD ;updates dosing array
- +1 KILL PSORXED("CONJUNCTION",ENT)
- SET I=ENT+1
- DO RV
- +2 SET HENT=ENT
- UPD1 ;
- +1 SET I=HENT+1
- SET J=I+1
- +2 IF $GET(PSORXED("CONJUNCTION",I))]""
- IF '$DATA(PSORXED("DOSE",J))
- KILL PSORXED("CONJUNCTION",I)
- QUIT
- +3 IF $GET(PSORXED("CONJUNCTION",I))]""
- SET PSORXED("CONJUNCTION",HENT)=PSORXED("CONJUNCTION",I)
- Begin DoDot:1
- +4 KILL PSORXED("CONJUNCTION",I)
- IF $DATA(PSORXED("DOSE",J))
- Begin DoDot:2
- +5 SET PSORXED("DOSE",I)=PSORXED("DOSE",J)
- +6 SET PSORXED("DOSE ORDERED",I)=$GET(PSORXED("DOSE ORDERED",J))
- +7 SET PSORXED("UNITS",I)=$GET(PSORXED("UNITS",J))
- +8 SET PSORXED("NOUN",I)=$GET(PSORXED("NOUN",J))
- +9 SET PSORXED("VERB",I)=$GET(PSORXED("VERB",J))
- +10 SET PSORXED("DURATION",I)=$GET(PSORXED("DURATION",J))
- +11 SET PSORXED("CONJUNCTION",I)=$GET(PSORXED("CONJUNCTION",J))
- +12 SET PSORXED("ROUTE",I)=$GET(PSORXED("ROUTE",J))
- +13 SET PSORXED("SCHEDULE",I)=$GET(PSORXED("SCHEDULE",J))
- +14 SET PSORXED("ODOSE",I)=$GET(PSORXED("ODOSE",J))
- +15 SET HENT=HENT+1
- SET I=HENT+1
- +16 IF $GET(PSORXED("CONJUNCTION",I))]""
- QUIT
- +17 KILL PSORXED("CONJUNCTION",I)
- DO RV
- End DoDot:2
- End DoDot:1
- GOTO UPD1
- +18 SET PSORXED("ENT")=HENT
- KILL HENT
- DO EN^PSOFSIG(.PSORXED)
- +19 QUIT
- RV KILL PSORXED("UNITS",I),PSORXED("NOUN",I),PSORXED("DURATION",I),PSORXED("ROUTE",I),PSORXED("SCHEDULE",I),PSORXED("DOSE",I),PSORXED("DOSE ORDERED",I),PSORXED("VERB",I),PSORXED("ODOSE",I)
- +1 QUIT
- M1 SET VALMSG="Prescription Not Updated!"
- +1 QUIT
- M2 SET VALMSG="This edit will create a new prescription!"
- +1 QUIT
- M3 SET VALMSG=$SELECT($GET(COPY):"Copy Request Cancelled!",1:"Prescription Not Updated!")
- +1 QUIT
- MP1 SET VALMSG="Pending Order Not Updated!"
- +1 QUIT