- PSOSIG ;BIR/RTR-Utility to create SIG ;Feb 25, 2021@14:48
- ;;7.0;OUTPATIENT PHARMACY;**46,99,114,391,313,282,455,446,402,500,515,514,574,584,449**;DEC 1997;Build 2
- ;External reference to PS(51 supported by DBIA 2224
- ;External reference to PS(51.1 supported by DBIA 2225
- ;External reference to PSDRUG( supported by DBIA 221
- ;
- EN(PSOSIGX) ;
- N VARIABLE
- Q
- SCH ;*282 Preserve old functionality
- I $D(DTOUT)!($D(DUOUT)) Q
- I Y>0!($G(SCH)[" ") S SCHEX=$$SCHE(SCH)
- I Y'>0 W !,?2,"Free text '"_$G(SCH)_"' entered for schedule"
- Q
- ;
- ;SCHE is the new schedule expander
- SCHE(SCH) ;
- ;SCH = Schedule entered
- ;Returns Expanded Schedule, or ""
- N SCHEX,SPCT
- I SCH[""""!($A(SCH)=45)!(SCH?.E1C.E)!($L(SCH," ")>$S(SCH["PRN":4,1:3))!($L(SCH)>20)!($L(SCH)<1) K SCH Q ""
- S SCH=$$UPPER(SCH)
- S SPCT=0 F I=1:1:$L(SCH) I $E(SCH,I)=" " S SPCT=SPCT+1
- S SCHEX=$$EXP(SCH) I SCHEX]"" Q SCHEX
- Q:SPCT=0 SCH
- Q $$SCHE($P(SCH," ",1,SPCT))_" "_$$SCHE($P(SCH," ",SPCT+1))
- EXP(X) ; expand based on 51.1 and 51
- N PSIN,SCFLG,SCHEX
- S PSIN=0 F S PSIN=$O(^PS(51.1,"APPSJ",X,PSIN)) Q:'PSIN!$G(SCFLG) I $P(^PS(51.1,PSIN,0),"^",8)'="" S SCHEX=$P($G(^(0)),"^",8),SCFLG=1
- Q:$G(SCFLG) SCHEX
- S PSIN=0 F S PSIN=$O(^PS(51.1,"D",X,PSIN)) Q:'PSIN!$G(SCFLG) I $P(^PS(51.1,PSIN,0),"^",8)'="" S SCHEX=$P($G(^(0)),"^",8),SCFLG=1
- Q:$G(SCFLG) SCHEX
- S PSIN=0 F S PSIN=$O(^PS(51,"B",X,PSIN)) Q:'PSIN!$G(SCLFL) I PSIN,($P(^PS(51,PSIN,0),"^",4)<2)&($P($G(^PS(51,"A",X)),"^")'="") S SCHEX=$P(^(X),"^"),SCFLG=1
- Q:$G(SCFLG) SCHEX
- S PSIN=0 F S PSIN=$O(^PS(51,"D",X,PSIN)) Q:'PSIN!$G(SCLFL) I PSIN,($P(^PS(51,PSIN,0),"^",4)<2)&($P($G(^PS(51,"A",X)),"^")'="") S SCHEX=$P(^(X),"^"),SCFLG=1
- Q:$G(SCFLG) SCHEX
- I X[" " Q ""
- ; expand DOW ;p449
- N DOW,VAL,VAL1,STR,I,Y,XX,YY,TM
- S DOW="SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY",(STR,SCHEX)="",TM=$P(X,"@",2)
- F I=1:1:$L(X)+1 S VAL=$E(X,I) S:VAL?1AN STR=STR_VAL I VAL'?1AN D I VAL="@" Q
- .Q:STR=""
- .F J=1:1:7 S VAL1=$P(DOW,";",J),XX=0 I STR'="",(";"_VAL1)[(";"_STR) S YY=$P(SCHEX," ",$L(SCHEX," ")),SCHEX=$S(SCHEX="":"",DOW'[YY:SCHEX_" ",1:SCHEX_", ")_VAL1,STR="",XX=1 Q
- .I 'XX,SCHEX'="" S YY=$P(SCHEX," ",$L(SCHEX," ")),SCHEX=$S(SCHEX="":"",DOW'[YY:SCHEX_" ",1:SCHEX_" ")_STR,STR=""
- I SCHEX="" Q ""
- S XX=$L(SCHEX,", ") I XX>1 S STR=$P(SCHEX,", ",1,XX-1)_" AND "_$P(SCHEX,", ",XX),SCHEX=STR
- I SCHEX=X Q ""
- Q SCHEX_$S(TM'="":"@",1:"")_TM
- ;
- QTY(PSOQX) ; PSOQX - Array containing Rx information
- N QDOSE,PSORXIEN,PSODSEDT,PSOOUTQT
- K PSOQX("QTY")
- S PSORXIEN=$S($G(PSOQX("IRXN")):+PSOQX("IRXN"),1:0)
- S PSODSEDT=$S(PSORXIEN&$D(PSOQX(52,PSORXIEN,8)):1,'PSORXIEN&($G(PSOQX("FLD"))=8):1,1:0) ; DAYS SUPPLY field edited
- I 'PSORXIEN,$G(PSOQX("FLD"))=7 Q ; QTY field being edite for Pending Order (do not ajust current QTY)
- S PSOOUTQT=1
- QTYCP ;CPRS qty call comes through here
- N PSQQUIT,QTSH,PSQ,PSQMIN,PSQMINZ,PSOQRND,PSOLOWER,PSOLOWX,PSOLOWXL,PSOLOWST,PSORXDRG
- K PSOFRQ S PSQQUIT=0
- I '$G(PSOCPRQT) S QDOSE=0 F PSQ=0:0 S PSQ=$O(PSOQX("DOSE",PSQ)) Q:'PSQ S QDOSE=PSQ S:'$G(PSOQX("DOSE ORDERED",PSQ)) PSQQUIT=1
- I '$G(PSOCPRQT) Q:PSQQUIT
- Q:'$G(PSOQX("DAYS SUPPLY"))
- Q:'$G(QDOSE)
- G:QDOSE>1 COMP
- Q:'$G(PSOQX("DOSE ORDERED",1))
- Q:'$G(PSOQX("DAYS SUPPLY"))&('$G(PSOQX("DURATION",1)))
- S PSOLOWER=0
- I $G(PSOQX("DURATION",1)) D
- .S PSOLOWX=$L(PSOQX("DURATION",1))
- .S PSOLOWXL=$S($E(PSOQX("DURATION",1),PSOLOWX)="M":1,$E(PSOQX("DURATION",1),PSOLOWX)="H":60,$E(PSOQX("DURATION",1),PSOLOWX)="S":.01666,$E(PSOQX("DURATION",1),PSOLOWX)="W":10080,$E(PSOQX("DURATION",1),PSOLOWX)="L":43200,1:1440)
- .S PSOLOWER=PSOLOWXL*(+$G(PSOQX("DURATION",1)))
- S PSOLOWX=0 I +$G(PSOQX("DAYS SUPPLY")) S PSOLOWX=1440*+$G(PSOQX("DAYS SUPPLY"))
- Q:'$G(PSOLOWER)&('$G(PSOLOWX))
- S QTSH=$G(PSOQX("SCHEDULE",1)) D QTS Q:PSQQUIT!('$G(PSOFRQ))
- S PSOLOWST=$S('$G(PSOLOWER):$G(PSOLOWX),'$G(PSOLOWX):$G(PSOLOWER),$G(PSOLOWER)>$G(PSOLOWX):$G(PSOLOWX),$G(PSOLOWX)>$G(PSOLOWER):$G(PSOLOWER),$G(PSOLOWX)=$G(PSOLOWER):$G(PSOLOWER),1:0)
- Q:'$G(PSOLOWST)
- S PSQMIN=+$G(PSOLOWST)
- S PSQMINZ=PSQMIN/PSOFRQ
- S PSOQRND=PSQMINZ*+$G(PSOQX("DOSE ORDERED",1)) Q:'PSOQRND
- ;If DAYS SUPPLY was edited by Pharmacy and previous quantity was calculated, don't calculate/update quantity automatically
- I $G(PSODSEDT),'$$UPDQTY(PSOQRND+.9999\1) Q
- ;If DISPENSE DRUG was edited in Pharmacy and SIG contains "PRN" on a CS Order, don't calculate/update quantity automatically
- S PSORXDRG=$S($G(PSORXIEN):$P($G(PSORXED("RX0")),"^",6),1:$P($G(OR0),"^",9))
- I $D(PSORXIEN),PSORXDRG,PSORXDRG'=+$G(PSODRUG("IEN")),$G(QTYHLD),$$CSDS^PSOSIGDS(+$G(PSODRUG("IEN"))),$$PRN() D Q
- . W !!,"The Quantity (",$G(QTYHLD),") has not been changed."
- . W !,"Please review and update it if necessary.",!,$C(7)
- . N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
- D ROUND G QEND
- Q
- COMP ;COMPLEX DOSE HERE
- N PSOQEXC,PSOQAND,PSOQTHEN,PSQL,PSQMNL,PSQMNLX,PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN
- ;PSODUTOT = TOTAL OF ALL DURATIONS
- ;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
- ;PSODUMIS = # OF SEQUENCES MISSING A DURATION IF >1 CAN'T DEFAULT
- ;PSODUREP = SEQUENCE # THAT IS MISSING DURATION
- ;PSODSMIN = MINUTES OF DAYS SUPPLY
- S (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQAND,PSOQTHEN,PSOQEXC)=0
- F PSQL=1:1:QDOSE S:$G(PSOQX("CONJUNCTION",PSQL))["A" PSOQAND=1 S:$G(PSOQX("CONJUNCTION",PSQL))["T" PSOQTHEN=1 S:$G(PSOQX("CONJUNCTION",PSQL))["X" PSOQEXC=1
- I $G(PSOQEXC) G QEND
- I $G(PSOQAND) G COMP^PSOSIGCX
- F PSQ1=1:1:QDOSE D Q:PSODUMIS>1
- .I '$G(PSOQX("DURATION",PSQ1)) S PSODUMIS=PSODUMIS+1,PSODUREP=PSQ1 Q
- .S PSODUX=$L(PSOQX("DURATION",PSQ1))
- .S PSODUXX=$S($E(PSOQX("DURATION",PSQ1),PSODUX)="M":1,$E(PSOQX("DURATION",PSQ1),PSODUX)="H":60,$E(PSOQX("DURATION",PSQ1),PSODUX)="S":.01666,$E(PSOQX("DURATION",PSQ1),PSODUX)="W":10080,$E(PSOQX("DURATION",PSQ1),PSODUX)="L":43200,1:1440)
- .S PSODUTOT=PSODUTOT+(PSODUXX*(+$G(PSOQX("DURATION",PSQ1))))
- G:PSODUMIS>1 QEND ; More than 1 sequence missing a duration
- I $G(PSODUMIS),'$G(PSOQX("DAYS SUPPLY")) G QEND ; missing 1 duration, no days supply
- S PSODSMIN=1440*+$G(PSOQX("DAYS SUPPLY"))
- I $G(PSODSMIN),$G(PSODSMIN)<$G(PSODUTOT) G QEND
- I '$G(PSODUMIS),$G(PSODSMIN),$G(PSODUTOT)>$G(PSODSMIN) G QEND ; no missing durations, but total durations are greater than days supply
- I $G(PSODUMIS),$G(PSODSMIN),$G(PSODSMIN)'>$G(PSODUTOT) G QEND ; 1 missing duration, and total of other durations are not less than days supply
- I '$G(PSODSMIN),$G(PSODUMIS) G QEND ; no days supply, missing a duration
- I $G(PSODUREP) S PSODUDIF=$G(PSODSMIN)-$G(PSODUTOT)
- F PSQ=1:1:QDOSE D Q:$G(PSQQUIT)
- .I '$G(PSOQX("DOSE ORDERED",PSQ))!($G(PSOQX("SCHEDULE",PSQ))="") S PSQQUIT=1 Q
- .S QTSH=$G(PSOQX("SCHEDULE",PSQ)) D QTS S:'$G(PSOFRQ) PSQQUIT=1 Q:$G(PSQQUIT)
- .I $G(PSOQX("DURATION",PSQ)) S PSQMNL=$L(PSOQX("DURATION",PSQ)) D
- ..S PSQMNLX=$S($E(PSOQX("DURATION",PSQ),PSQMNL)="M":1,$E(PSOQX("DURATION",PSQ),PSQMNL)="H":60,$E(PSOQX("DURATION",PSQ),PSQMNL)="S":.01666,$E(PSOQX("DURATION",PSQ),PSQMNL)="W":10080,$E(PSOQX("DURATION",PSQ),PSQMNL)="L":43200,1:1440)
- ..S PSQMIN=PSQMNLX*(+$G(PSOQX("DURATION",PSQ)))
- .I '$G(PSOQX("DURATION",PSQ)) S PSQMIN=$G(PSODUDIF)
- .S PSQMINZ=PSQMIN/PSOFRQ
- .S PSOQRND=$S('$G(PSOQRND):PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ)),1:$G(PSOQRND)+(PSQMINZ*+$G(PSOQX("DOSE ORDERED",PSQ))))
- I $G(PSQQUIT) G QEND
- ;If DAYS SUPPLY was edited by Pharmacy, don't re-calculate QTY automatically for Digitally Signed Pending Orders
- I $G(PSODSEDT),$G(QTYHLD),$G(PSOFDR),$P($G(OR0),"^",24) D Q
- . W !!,"The Quantity (",QTYHLD,") has not been changed."
- . W !,"Please review and update it if necessary.",!,$C(7)
- . N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
- I $G(PSOQRND) D ROUND
- G QEND
- QTS ;*282 Preserve Old Functionality
- S PSOFRQ=$$QTSCH(QTSH)
- I '$G(PSOFRQ) S PSQQUIT=1
- Q
- ;
- QTSCH(QTSH) ;
- ; Return Frequency for Schedule QTSH
- ; Otherwise return ""
- N PSOFRQ,SPCT,FOUND
- Q:$G(QTSH)="" ""
- Q:$E(QTSH,1)=" " ""
- S QTSH=$$UPPER(QTSH)
- S SPCT=1,PSOFRQ=0 F I=1:1:$L(QTSH) I $E(QTSH,I)=" " S SPCT=SPCT+1
- F I=0:1:SPCT-1 S SCHTMP=$P(QTSH," ",1,SPCT-I) Q:PSOFRQ D
- . F II=0:0 S II=$O(^PS(51.1,"APPSJ",SCHTMP,II)) Q:'II!PSOFRQ S PSOFRQ=$P(^PS(51.1,II,0),"^",3)
- Q:PSOFRQ PSOFRQ
- F I=0:1:SPCT-1 S SCHTMP=$P(QTSH," ",1,SPCT-I) Q:PSOFRQ D
- . F II=0:0 S II=$O(^PS(51,"B",SCHTMP,II)) Q:'II!PSOFRQ I $P(^PS(51,II,0),"^",4)<2 S PSOFRQ=$P(^PS(51,II,0),"^",8)
- Q:PSOFRQ PSOFRQ
- Q ""
- ;
- QEND ;
- ; PSOMTFLG variable indicates a Maintenance Rx (Titration/Maintenance)
- ; PSO*7.0*574 ;Defect 1155637
- K PSOFRQ
- I $G(PSOOUTQT),$G(QTYHLD),$G(PSOQX("QTY")),$G(QTYHLD)'=$G(PSOQX("QTY")) D I '$G(PSOMTFLG) W ! N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
- .W:$P($G(^PSDRUG(PSODRUG("IEN"),"CLOZ1")),U)'="PSOCLO1" !!,"Quantity has been changed from "_QTYHLD_" to "_PSOQX("QTY")
- .I $G(PSONEW("FLD"))=8,$P($G(OR0),"^",24),$G(PSODRUG("IEN")),$D(^PSDRUG(+$G(PSODRUG("IEN")),0)) D
- ..I $P(^PSDRUG(PSODRUG("IEN"),0),"^",3)[2!($P(^PSDRUG(PSODRUG("IEN"),0),"^",3)["F") Q
- ..N ZRFA S ZRFA=$S($G(CLOZPAT)=2&(PSOQX("DAYS SUPPLY")=14):1,$G(CLOZPAT)=2&(PSOQX("DAYS SUPPLY")=7):3,$G(CLOZPAT)=1&(PSOQX("DAYS SUPPLY")=7):1,$D(CLOZPAT):0,1:5)
- ..N ZREF,ZTQ S ZREF=QTYHLD\PSOQX("QTY") I ZREF>0 D
- ...S ZTQ=QTYHLD*(PSOQX("# OF REFILLS")+1),ZTQ=ZTQ-PSOQX("QTY"),ZREF=ZTQ\PSOQX("QTY") S:ZREF>ZRFA ZREF=ZRFA
- ...I ZREF'=PSOQX("# OF REFILLS") W !,"# of Refills has been changed from "_PSOQX("# OF REFILLS")_" to "_ZREF S PSOQX("# OF REFILLS")=ZREF
- Q
- ROUND ;
- Q:'$G(PSOQRND)
- Q:$$PRN() ;584 - Do not create a default quantity for a PRN prescription
- I PSOQRND'["." S PSOQX("QTY")=PSOQRND Q
- S PSOQX("QTY")=$P(PSOQRND,".")+1
- Q
- DAY(DATE) ;First 5 digits of FileMan date
- N X
- I DATE'?5N Q -1
- S X=$E(DATE,4,5) I X<1!(X>12) Q -1
- S X=DATE+1+(X=12*88)_"01"
- Q $E($$FMADD^XLFDT(X,-1),6,7)
- ;
- QTYX(PSOQX) ;
- N PSOQLP,PSOQLN,PSOQAR,PSOCPRQT,QDOSE,QDOSEX S PSOCPRQT=1 F PSOQLP=0:0 S PSOQLP=$O(PSOQX("DURATION",PSOQLP)) Q:'PSOQLP D
- .S PSOQAR("DURATION",PSOQLP)=$G(PSOQX("DURATION",PSOQLP))
- .I $E(PSOQX("DURATION",PSOQLP))?1A S PSOQLN=$L(PSOQX("DURATION",PSOQLP)) S PSOQX("DURATION",PSOQLP)=$E(PSOQX("DURATION",PSOQLP),2,PSOQLN)_$E(PSOQX("DURATION",PSOQLP))
- S QDOSE=0 F QDOSEX=0:0 S QDOSEX=$O(PSOQX("DOSE ORDERED",QDOSEX)) Q:'QDOSEX S QDOSE=QDOSE+1
- I '$G(PSOQX("QTY")) D QTYCP G QPASS
- D QTYCP^PSOSIGDS
- QPASS F PSOQLP=0:0 S PSOQLP=$O(PSOQAR("DURATION",PSOQLP)) Q:'PSOQLP D
- .S PSOQX("DURATION",PSOQLP)=$G(PSOQAR("DURATION",PSOQLP))
- K PSOCPRQT
- Q
- DAYS(PSOQX) ;Entry point for Days Supply calc for PSO
- ;Kill days supply here
- Q:'$G(PSOQX("QTY"))
- D QTYOPS^PSOSIGDS
- Q
- ;
- UPDQTY(NEWQTY) ; If DAYS SUPPLY is being edited and previous QTY was not calculated, don't calculate and update QTY
- ; Also, if digitally signed, do not automatically calculate and update quantity if QTY increases
- ; Input: NEWQTY - Newly Calculated Quantity
- ;Output: 1: YES - Update Rx with re-calculated QTY / 0: NO - Don't update Rx with re-calculated QTY
- N UPDQTY,PSOFREQ,PSOOLDDS,PSONEWDS,PSOOLDQT,PSODOSOR,PSODUR
- S UPDQTY=1 I 'NEWQTY Q UPDQTY
- S PSOOLDDS=$G(PSOQX("DAYS SUPPLY OLD")) I 'PSOOLDDS Q UPDQTY ; DAYS SUPPLY value prior to edit
- S PSONEWDS=$G(PSOQX("DAYS SUPPLY")) I 'PSONEWDS Q UPDQTY ; New DAYS SUPPLY value
- S PSOOLDQT=$G(QTYHLD) I 'PSOOLDQT Q UPDQTY ; QTY on file, possibly calculated
- S PSOFREQ=$$SCHFREQ(),PSODOSOR=$G(PSOQX("DOSE ORDERED",1))
- S PSODUR=$G(PSOQX("DURATION",1)) I PSODUR,PSODUR<PSOOLDDS S PSOOLDDS=PSODUR
- ;
- ;Checking whether current QTY was previously calculated, if not don't update with new QTY
- I (PSODOSOR<1)!(PSOFREQ>1440) D
- . ;Different calculation for doses of less than one QTY (e.g., 1/2 tablet) OR frequency less than every 24hrs (e.g., every 72hrs)
- . I PSOFREQ,(((PSOOLDDS*(1440/PSOFREQ))*PSODOSOR)+.9\1)'=PSOOLDQT S UPDQTY=0
- E D
- . ;Checking whether current QTY was previously calculated
- . I ((NEWQTY/PSONEWDS)'=(PSOOLDQT/PSOOLDDS)) S UPDQTY=0
- ;
- ;QTY is increasing for a CS Rx/Order, so don't update with new QTY
- I ($G(PSOFDR)&$P($G(OR0),"^",24)&(NEWQTY>PSOOLDQT)) S UPDQTY=0
- ;
- I 'UPDQTY D
- . W !!,"The Quantity (",PSOOLDQT,") has not been changed."
- . W !,"Please review and update it if necessary.",!,$C(7)
- . N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
- Q UPDQTY
- ;
- SCHFREQ() ; Returns the Frequency (in minutes) for the schedule
- ; Output: SCHFREQ - Schedule Frequency (in minutes)
- N SCHED,SCHEDIEN
- S SCHED=$G(PSOQX("SCHEDULE",1)) I SCHED="" Q 0
- S SCHEDIEN=$O(^PS(51.1,"B",SCHED,0)) I SCHEDIEN Q $$GET1^DIQ(51.1,SCHEDIEN,2)
- S SCHEDIEN=$O(^PS(51,"B",SCHED,0)) I SCHEDIEN Q $$GET1^DIQ(51,SCHEDIEN,31)
- Q 0
- ;
- PRN() ; Returns if the Schedule is PRN (1) or not (0)
- N PRN,SCH S PRN=0
- F SCH=1:1 Q:'$D(PSOQX("SCHEDULE",SCH)) I $G(PSOQX("SCHEDULE",SCH))["PRN" S PRN=1 Q
- Q PRN
- ;
- UPPER(PSOSCUP) ;
- Q $TR(PSOSCUP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSIG 13026 printed Jan 18, 2025@03:35:59 Page 2
- PSOSIG ;BIR/RTR-Utility to create SIG ;Feb 25, 2021@14:48
- +1 ;;7.0;OUTPATIENT PHARMACY;**46,99,114,391,313,282,455,446,402,500,515,514,574,584,449**;DEC 1997;Build 2
- +2 ;External reference to PS(51 supported by DBIA 2224
- +3 ;External reference to PS(51.1 supported by DBIA 2225
- +4 ;External reference to PSDRUG( supported by DBIA 221
- +5 ;
- EN(PSOSIGX) ;
- +1 NEW VARIABLE
- +2 QUIT
- SCH ;*282 Preserve old functionality
- +1 IF $DATA(DTOUT)!($DATA(DUOUT))
- QUIT
- +2 IF Y>0!($GET(SCH)[" ")
- SET SCHEX=$$SCHE(SCH)
- +3 IF Y'>0
- WRITE !,?2,"Free text '"_$GET(SCH)_"' entered for schedule"
- +4 QUIT
- +5 ;
- +6 ;SCHE is the new schedule expander
- SCHE(SCH) ;
- +1 ;SCH = Schedule entered
- +2 ;Returns Expanded Schedule, or ""
- +3 NEW SCHEX,SPCT
- +4 IF SCH[""""!($ASCII(SCH)=45)!(SCH?.E1C.E)!($LENGTH(SCH," ")>$SELECT(SCH["PRN":4,1:3))!($LENGTH(SCH)>20)!($LENGTH(SCH)<1)
- KILL SCH
- QUIT ""
- +5 SET SCH=$$UPPER(SCH)
- +6 SET SPCT=0
- FOR I=1:1:$LENGTH(SCH)
- IF $EXTRACT(SCH,I)=" "
- SET SPCT=SPCT+1
- +7 SET SCHEX=$$EXP(SCH)
- IF SCHEX]""
- QUIT SCHEX
- +8 if SPCT=0
- QUIT SCH
- +9 QUIT $$SCHE($PIECE(SCH," ",1,SPCT))_" "_$$SCHE($PIECE(SCH," ",SPCT+1))
- EXP(X) ; expand based on 51.1 and 51
- +1 NEW PSIN,SCFLG,SCHEX
- +2 SET PSIN=0
- FOR
- SET PSIN=$ORDER(^PS(51.1,"APPSJ",X,PSIN))
- if 'PSIN!$GET(SCFLG)
- QUIT
- IF $PIECE(^PS(51.1,PSIN,0),"^",8)'=""
- SET SCHEX=$PIECE($GET(^(0)),"^",8)
- SET SCFLG=1
- +3 if $GET(SCFLG)
- QUIT SCHEX
- +4 SET PSIN=0
- FOR
- SET PSIN=$ORDER(^PS(51.1,"D",X,PSIN))
- if 'PSIN!$GET(SCFLG)
- QUIT
- IF $PIECE(^PS(51.1,PSIN,0),"^",8)'=""
- SET SCHEX=$PIECE($GET(^(0)),"^",8)
- SET SCFLG=1
- +5 if $GET(SCFLG)
- QUIT SCHEX
- +6 SET PSIN=0
- FOR
- SET PSIN=$ORDER(^PS(51,"B",X,PSIN))
- if 'PSIN!$GET(SCLFL)
- QUIT
- IF PSIN
- IF ($PIECE(^PS(51,PSIN,0),"^",4)<2)&($PIECE($GET(^PS(51,"A",X)),"^")'="")
- SET SCHEX=$PIECE(^(X),"^")
- SET SCFLG=1
- +7 if $GET(SCFLG)
- QUIT SCHEX
- +8 SET PSIN=0
- FOR
- SET PSIN=$ORDER(^PS(51,"D",X,PSIN))
- if 'PSIN!$GET(SCLFL)
- QUIT
- IF PSIN
- IF ($PIECE(^PS(51,PSIN,0),"^",4)<2)&($PIECE($GET(^PS(51,"A",X)),"^")'="")
- SET SCHEX=$PIECE(^(X),"^")
- SET SCFLG=1
- +9 if $GET(SCFLG)
- QUIT SCHEX
- +10 IF X[" "
- QUIT ""
- +11 ; expand DOW ;p449
- +12 NEW DOW,VAL,VAL1,STR,I,Y,XX,YY,TM
- +13 SET DOW="SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY"
- SET (STR,SCHEX)=""
- SET TM=$PIECE(X,"@",2)
- +14 FOR I=1:1:$LENGTH(X)+1
- SET VAL=$EXTRACT(X,I)
- if VAL?1AN
- SET STR=STR_VAL
- IF VAL'?1AN
- Begin DoDot:1
- +15 if STR=""
- QUIT
- +16 FOR J=1:1:7
- SET VAL1=$PIECE(DOW,";",J)
- SET XX=0
- IF STR'=""
- IF (";"_VAL1)[(";"_STR)
- SET YY=$PIECE(SCHEX," ",$LENGTH(SCHEX," "))
- SET SCHEX=$SELECT(SCHEX="":"",DOW'[YY:SCHEX_" ",1:SCHEX_", ")_VAL1
- SET STR=""
- SET XX=1
- QUIT
- +17 IF 'XX
- IF SCHEX'=""
- SET YY=$PIECE(SCHEX," ",$LENGTH(SCHEX," "))
- SET SCHEX=$SELECT(SCHEX="":"",DOW'[YY:SCHEX_" ",1:SCHEX_" ")_STR
- SET STR=""
- End DoDot:1
- IF VAL="@"
- QUIT
- +18 IF SCHEX=""
- QUIT ""
- +19 SET XX=$LENGTH(SCHEX,", ")
- IF XX>1
- SET STR=$PIECE(SCHEX,", ",1,XX-1)_" AND "_$PIECE(SCHEX,", ",XX)
- SET SCHEX=STR
- +20 IF SCHEX=X
- QUIT ""
- +21 QUIT SCHEX_$SELECT(TM'="":"@",1:"")_TM
- +22 ;
- QTY(PSOQX) ; PSOQX - Array containing Rx information
- +1 NEW QDOSE,PSORXIEN,PSODSEDT,PSOOUTQT
- +2 KILL PSOQX("QTY")
- +3 SET PSORXIEN=$SELECT($GET(PSOQX("IRXN")):+PSOQX("IRXN"),1:0)
- +4 ; DAYS SUPPLY field edited
- SET PSODSEDT=$SELECT(PSORXIEN&$DATA(PSOQX(52,PSORXIEN,8)):1,'PSORXIEN&($GET(PSOQX("FLD"))=8):1,1:0)
- +5 ; QTY field being edite for Pending Order (do not ajust current QTY)
- IF 'PSORXIEN
- IF $GET(PSOQX("FLD"))=7
- QUIT
- +6 SET PSOOUTQT=1
- QTYCP ;CPRS qty call comes through here
- +1 NEW PSQQUIT,QTSH,PSQ,PSQMIN,PSQMINZ,PSOQRND,PSOLOWER,PSOLOWX,PSOLOWXL,PSOLOWST,PSORXDRG
- +2 KILL PSOFRQ
- SET PSQQUIT=0
- +3 IF '$GET(PSOCPRQT)
- SET QDOSE=0
- FOR PSQ=0:0
- SET PSQ=$ORDER(PSOQX("DOSE",PSQ))
- if 'PSQ
- QUIT
- SET QDOSE=PSQ
- if '$GET(PSOQX("DOSE ORDERED",PSQ))
- SET PSQQUIT=1
- +4 IF '$GET(PSOCPRQT)
- if PSQQUIT
- QUIT
- +5 if '$GET(PSOQX("DAYS SUPPLY"))
- QUIT
- +6 if '$GET(QDOSE)
- QUIT
- +7 if QDOSE>1
- GOTO COMP
- +8 if '$GET(PSOQX("DOSE ORDERED",1))
- QUIT
- +9 if '$GET(PSOQX("DAYS SUPPLY"))&('$GET(PSOQX("DURATION",1)))
- QUIT
- +10 SET PSOLOWER=0
- +11 IF $GET(PSOQX("DURATION",1))
- Begin DoDot:1
- +12 SET PSOLOWX=$LENGTH(PSOQX("DURATION",1))
- +13 SET PSOLOWXL=$SELECT($EXTRACT(PSOQX("DURATION",1),PSOLOWX)="M":1,$EXTRACT(PSOQX("DURATION",1),PSOLOWX)="H":60,$EXTRACT(PSOQX("DURATION",1),PSOLOWX)="S":.01666,...
- ... $EXTRACT(PSOQX("DURATION",1),PSOLOWX)="W":10080,$EXTRACT(PSOQX("DURATION",1),PSOLOWX)="L":43200,1:1440)
- +14 SET PSOLOWER=PSOLOWXL*(+$GET(PSOQX("DURATION",1)))
- End DoDot:1
- +15 SET PSOLOWX=0
- IF +$GET(PSOQX("DAYS SUPPLY"))
- SET PSOLOWX=1440*+$GET(PSOQX("DAYS SUPPLY"))
- +16 if '$GET(PSOLOWER)&('$GET(PSOLOWX))
- QUIT
- +17 SET QTSH=$GET(PSOQX("SCHEDULE",1))
- DO QTS
- if PSQQUIT!('$GET(PSOFRQ))
- QUIT
- +18 SET PSOLOWST=$SELECT('$GET(PSOLOWER):$GET(PSOLOWX),'$GET(PSOLOWX):$GET(PSOLOWER),$GET(PSOLOWER)>$GET(PSOLOWX):$GET(PSOLOWX),$GET(PSOLOWX)>$GET(PSOLOWER):$GET(PSOLOWER),$GET(PSOLOWX)=$GET(PSOLOWER):$GET(PSOLOWER),1:0)
- +19 if '$GET(PSOLOWST)
- QUIT
- +20 SET PSQMIN=+$GET(PSOLOWST)
- +21 SET PSQMINZ=PSQMIN/PSOFRQ
- +22 SET PSOQRND=PSQMINZ*+$GET(PSOQX("DOSE ORDERED",1))
- if 'PSOQRND
- QUIT
- +23 ;If DAYS SUPPLY was edited by Pharmacy and previous quantity was calculated, don't calculate/update quantity automatically
- +24 IF $GET(PSODSEDT)
- IF '$$UPDQTY(PSOQRND+.9999\1)
- QUIT
- +25 ;If DISPENSE DRUG was edited in Pharmacy and SIG contains "PRN" on a CS Order, don't calculate/update quantity automatically
- +26 SET PSORXDRG=$SELECT($GET(PSORXIEN):$PIECE($GET(PSORXED("RX0")),"^",6),1:$PIECE($GET(OR0),"^",9))
- +27 IF $DATA(PSORXIEN)
- IF PSORXDRG
- IF PSORXDRG'=+$GET(PSODRUG("IEN"))
- IF $GET(QTYHLD)
- IF $$CSDS^PSOSIGDS(+$GET(PSODRUG("IEN")))
- IF $$PRN()
- Begin DoDot:1
- +28 WRITE !!,"The Quantity (",$GET(QTYHLD),") has not been changed."
- +29 WRITE !,"Please review and update it if necessary.",!,$CHAR(7)
- +30 NEW DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- WRITE !
- End DoDot:1
- QUIT
- +31 DO ROUND
- GOTO QEND
- +32 QUIT
- COMP ;COMPLEX DOSE HERE
- +1 NEW PSOQEXC,PSOQAND,PSOQTHEN,PSQL,PSQMNL,PSQMNLX,PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSQ1,PSODUX,PSODUXX,PSODSMIN
- +2 ;PSODUTOT = TOTAL OF ALL DURATIONS
- +3 ;PSODUDIF = DIFF. OF DURATION VS DAYS SUPPLY
- +4 ;PSODUMIS = # OF SEQUENCES MISSING A DURATION IF >1 CAN'T DEFAULT
- +5 ;PSODUREP = SEQUENCE # THAT IS MISSING DURATION
- +6 ;PSODSMIN = MINUTES OF DAYS SUPPLY
- +7 SET (PSODUTOT,PSODUDIF,PSODUMIS,PSODUREP,PSODSMIN,PSOQAND,PSOQTHEN,PSOQEXC)=0
- +8 FOR PSQL=1:1:QDOSE
- if $GET(PSOQX("CONJUNCTION",PSQL))["A"
- SET PSOQAND=1
- if $GET(PSOQX("CONJUNCTION",PSQL))["T"
- SET PSOQTHEN=1
- if $GET(PSOQX("CONJUNCTION",PSQL))["X"
- SET PSOQEXC=1
- +9 IF $GET(PSOQEXC)
- GOTO QEND
- +10 IF $GET(PSOQAND)
- GOTO COMP^PSOSIGCX
- +11 FOR PSQ1=1:1:QDOSE
- Begin DoDot:1
- +12 IF '$GET(PSOQX("DURATION",PSQ1))
- SET PSODUMIS=PSODUMIS+1
- SET PSODUREP=PSQ1
- QUIT
- +13 SET PSODUX=$LENGTH(PSOQX("DURATION",PSQ1))
- +14 SET PSODUXX=$SELECT($EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="M":1,$EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="H":60,...
- ... $EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="S":.01666,$EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="W":10080,$EXTRACT(PSOQX("DURATION",PSQ1),PSODUX)="L":43200,1:1440)
- +15 SET PSODUTOT=PSODUTOT+(PSODUXX*(+$GET(PSOQX("DURATION",PSQ1))))
- End DoDot:1
- if PSODUMIS>1
- QUIT
- +16 ; More than 1 sequence missing a duration
- if PSODUMIS>1
- GOTO QEND
- +17 ; missing 1 duration, no days supply
- IF $GET(PSODUMIS)
- IF '$GET(PSOQX("DAYS SUPPLY"))
- GOTO QEND
- +18 SET PSODSMIN=1440*+$GET(PSOQX("DAYS SUPPLY"))
- +19 IF $GET(PSODSMIN)
- IF $GET(PSODSMIN)<$GET(PSODUTOT)
- GOTO QEND
- +20 ; no missing durations, but total durations are greater than days supply
- IF '$GET(PSODUMIS)
- IF $GET(PSODSMIN)
- IF $GET(PSODUTOT)>$GET(PSODSMIN)
- GOTO QEND
- +21 ; 1 missing duration, and total of other durations are not less than days supply
- IF $GET(PSODUMIS)
- IF $GET(PSODSMIN)
- IF $GET(PSODSMIN)'>$GET(PSODUTOT)
- GOTO QEND
- +22 ; no days supply, missing a duration
- IF '$GET(PSODSMIN)
- IF $GET(PSODUMIS)
- GOTO QEND
- +23 IF $GET(PSODUREP)
- SET PSODUDIF=$GET(PSODSMIN)-$GET(PSODUTOT)
- +24 FOR PSQ=1:1:QDOSE
- Begin DoDot:1
- +25 IF '$GET(PSOQX("DOSE ORDERED",PSQ))!($GET(PSOQX("SCHEDULE",PSQ))="")
- SET PSQQUIT=1
- QUIT
- +26 SET QTSH=$GET(PSOQX("SCHEDULE",PSQ))
- DO QTS
- if '$GET(PSOFRQ)
- SET PSQQUIT=1
- if $GET(PSQQUIT)
- QUIT
- +27 IF $GET(PSOQX("DURATION",PSQ))
- SET PSQMNL=$LENGTH(PSOQX("DURATION",PSQ))
- Begin DoDot:2
- +28 SET PSQMNLX=$SELECT($EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="M":1,$EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="H":60,$EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="S":.01666,...
- ... $EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="W":10080,$EXTRACT(PSOQX("DURATION",PSQ),PSQMNL)="L":43200,1:1440)
- +29 SET PSQMIN=PSQMNLX*(+$GET(PSOQX("DURATION",PSQ)))
- End DoDot:2
- +30 IF '$GET(PSOQX("DURATION",PSQ))
- SET PSQMIN=$GET(PSODUDIF)
- +31 SET PSQMINZ=PSQMIN/PSOFRQ
- +32 SET PSOQRND=$SELECT('$GET(PSOQRND):PSQMINZ*+$GET(PSOQX("DOSE ORDERED",PSQ)),1:$GET(PSOQRND)+(PSQMINZ*+$GET(PSOQX("DOSE ORDERED",PSQ))))
- End DoDot:1
- if $GET(PSQQUIT)
- QUIT
- +33 IF $GET(PSQQUIT)
- GOTO QEND
- +34 ;If DAYS SUPPLY was edited by Pharmacy, don't re-calculate QTY automatically for Digitally Signed Pending Orders
- +35 IF $GET(PSODSEDT)
- IF $GET(QTYHLD)
- IF $GET(PSOFDR)
- IF $PIECE($GET(OR0),"^",24)
- Begin DoDot:1
- +36 WRITE !!,"The Quantity (",QTYHLD,") has not been changed."
- +37 WRITE !,"Please review and update it if necessary.",!,$CHAR(7)
- +38 NEW DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- WRITE !
- End DoDot:1
- QUIT
- +39 IF $GET(PSOQRND)
- DO ROUND
- +40 GOTO QEND
- QTS ;*282 Preserve Old Functionality
- +1 SET PSOFRQ=$$QTSCH(QTSH)
- +2 IF '$GET(PSOFRQ)
- SET PSQQUIT=1
- +3 QUIT
- +4 ;
- QTSCH(QTSH) ;
- +1 ; Return Frequency for Schedule QTSH
- +2 ; Otherwise return ""
- +3 NEW PSOFRQ,SPCT,FOUND
- +4 if $GET(QTSH)=""
- QUIT ""
- +5 if $EXTRACT(QTSH,1)=" "
- QUIT ""
- +6 SET QTSH=$$UPPER(QTSH)
- +7 SET SPCT=1
- SET PSOFRQ=0
- FOR I=1:1:$LENGTH(QTSH)
- IF $EXTRACT(QTSH,I)=" "
- SET SPCT=SPCT+1
- +8 FOR I=0:1:SPCT-1
- SET SCHTMP=$PIECE(QTSH," ",1,SPCT-I)
- if PSOFRQ
- QUIT
- Begin DoDot:1
- +9 FOR II=0:0
- SET II=$ORDER(^PS(51.1,"APPSJ",SCHTMP,II))
- if 'II!PSOFRQ
- QUIT
- SET PSOFRQ=$PIECE(^PS(51.1,II,0),"^",3)
- End DoDot:1
- +10 if PSOFRQ
- QUIT PSOFRQ
- +11 FOR I=0:1:SPCT-1
- SET SCHTMP=$PIECE(QTSH," ",1,SPCT-I)
- if PSOFRQ
- QUIT
- Begin DoDot:1
- +12 FOR II=0:0
- SET II=$ORDER(^PS(51,"B",SCHTMP,II))
- if 'II!PSOFRQ
- QUIT
- IF $PIECE(^PS(51,II,0),"^",4)<2
- SET PSOFRQ=$PIECE(^PS(51,II,0),"^",8)
- End DoDot:1
- +13 if PSOFRQ
- QUIT PSOFRQ
- +14 QUIT ""
- +15 ;
- QEND ;
- +1 ; PSOMTFLG variable indicates a Maintenance Rx (Titration/Maintenance)
- +2 ; PSO*7.0*574 ;Defect 1155637
- +3 KILL PSOFRQ
- +4 IF $GET(PSOOUTQT)
- IF $GET(QTYHLD)
- IF $GET(PSOQX("QTY"))
- IF $GET(QTYHLD)'=$GET(PSOQX("QTY"))
- Begin DoDot:1
- +5 if $PIECE($GET(^PSDRUG(PSODRUG("IEN"),"CLOZ1")),U)'="PSOCLO1"
- WRITE !!,"Quantity has been changed from "_QTYHLD_" to "_PSOQX("QTY")
- +6 IF $GET(PSONEW("FLD"))=8
- IF $PIECE($GET(OR0),"^",24)
- IF $GET(PSODRUG("IEN"))
- IF $DATA(^PSDRUG(+$GET(PSODRUG("IEN")),0))
- Begin DoDot:2
- +7 IF $PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",3)[2!($PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",3)["F")
- QUIT
- +8 NEW ZRFA
- SET ZRFA=$SELECT($GET(CLOZPAT)=2&(PSOQX("DAYS SUPPLY")=14):1,$GET(CLOZPAT)=2&(PSOQX("DAYS SUPPLY")=7):3,$GET(CLOZPAT)=1&(PSOQX("DAYS SUPPLY")=7):1,$DATA(CLOZPAT):0,1:5)
- +9 NEW ZREF,ZTQ
- SET ZREF=QTYHLD\PSOQX("QTY")
- IF ZREF>0
- Begin DoDot:3
- +10 SET ZTQ=QTYHLD*(PSOQX("# OF REFILLS")+1)
- SET ZTQ=ZTQ-PSOQX("QTY")
- SET ZREF=ZTQ\PSOQX("QTY")
- if ZREF>ZRFA
- SET ZREF=ZRFA
- +11 IF ZREF'=PSOQX("# OF REFILLS")
- WRITE !,"# of Refills has been changed from "_PSOQX("# OF REFILLS")_" to "_ZREF
- SET PSOQX("# OF REFILLS")=ZREF
- End DoDot:3
- End DoDot:2
- End DoDot:1
- IF '$GET(PSOMTFLG)
- WRITE !
- NEW DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- WRITE !
- +12 QUIT
- ROUND ;
- +1 if '$GET(PSOQRND)
- QUIT
- +2 ;584 - Do not create a default quantity for a PRN prescription
- if $$PRN()
- QUIT
- +3 IF PSOQRND'["."
- SET PSOQX("QTY")=PSOQRND
- QUIT
- +4 SET PSOQX("QTY")=$PIECE(PSOQRND,".")+1
- +5 QUIT
- DAY(DATE) ;First 5 digits of FileMan date
- +1 NEW X
- +2 IF DATE'?5N
- QUIT -1
- +3 SET X=$EXTRACT(DATE,4,5)
- IF X<1!(X>12)
- QUIT -1
- +4 SET X=DATE+1+(X=12*88)_"01"
- +5 QUIT $EXTRACT($$FMADD^XLFDT(X,-1),6,7)
- +6 ;
- QTYX(PSOQX) ;
- +1 NEW PSOQLP,PSOQLN,PSOQAR,PSOCPRQT,QDOSE,QDOSEX
- SET PSOCPRQT=1
- FOR PSOQLP=0:0
- SET PSOQLP=$ORDER(PSOQX("DURATION",PSOQLP))
- if 'PSOQLP
- QUIT
- Begin DoDot:1
- +2 SET PSOQAR("DURATION",PSOQLP)=$GET(PSOQX("DURATION",PSOQLP))
- +3 IF $EXTRACT(PSOQX("DURATION",PSOQLP))?1A
- SET PSOQLN=$LENGTH(PSOQX("DURATION",PSOQLP))
- SET PSOQX("DURATION",PSOQLP)=$EXTRACT(PSOQX("DURATION",PSOQLP),2,PSOQLN)_$EXTRACT(PSOQX("DURATION",PSOQLP))
- End DoDot:1
- +4 SET QDOSE=0
- FOR QDOSEX=0:0
- SET QDOSEX=$ORDER(PSOQX("DOSE ORDERED",QDOSEX))
- if 'QDOSEX
- QUIT
- SET QDOSE=QDOSE+1
- +5 IF '$GET(PSOQX("QTY"))
- DO QTYCP
- GOTO QPASS
- +6 DO QTYCP^PSOSIGDS
- QPASS FOR PSOQLP=0:0
- SET PSOQLP=$ORDER(PSOQAR("DURATION",PSOQLP))
- if 'PSOQLP
- QUIT
- Begin DoDot:1
- +1 SET PSOQX("DURATION",PSOQLP)=$GET(PSOQAR("DURATION",PSOQLP))
- End DoDot:1
- +2 KILL PSOCPRQT
- +3 QUIT
- DAYS(PSOQX) ;Entry point for Days Supply calc for PSO
- +1 ;Kill days supply here
- +2 if '$GET(PSOQX("QTY"))
- QUIT
- +3 DO QTYOPS^PSOSIGDS
- +4 QUIT
- +5 ;
- UPDQTY(NEWQTY) ; If DAYS SUPPLY is being edited and previous QTY was not calculated, don't calculate and update QTY
- +1 ; Also, if digitally signed, do not automatically calculate and update quantity if QTY increases
- +2 ; Input: NEWQTY - Newly Calculated Quantity
- +3 ;Output: 1: YES - Update Rx with re-calculated QTY / 0: NO - Don't update Rx with re-calculated QTY
- +4 NEW UPDQTY,PSOFREQ,PSOOLDDS,PSONEWDS,PSOOLDQT,PSODOSOR,PSODUR
- +5 SET UPDQTY=1
- IF 'NEWQTY
- QUIT UPDQTY
- +6 ; DAYS SUPPLY value prior to edit
- SET PSOOLDDS=$GET(PSOQX("DAYS SUPPLY OLD"))
- IF 'PSOOLDDS
- QUIT UPDQTY
- +7 ; New DAYS SUPPLY value
- SET PSONEWDS=$GET(PSOQX("DAYS SUPPLY"))
- IF 'PSONEWDS
- QUIT UPDQTY
- +8 ; QTY on file, possibly calculated
- SET PSOOLDQT=$GET(QTYHLD)
- IF 'PSOOLDQT
- QUIT UPDQTY
- +9 SET PSOFREQ=$$SCHFREQ()
- SET PSODOSOR=$GET(PSOQX("DOSE ORDERED",1))
- +10 SET PSODUR=$GET(PSOQX("DURATION",1))
- IF PSODUR
- IF PSODUR<PSOOLDDS
- SET PSOOLDDS=PSODUR
- +11 ;
- +12 ;Checking whether current QTY was previously calculated, if not don't update with new QTY
- +13 IF (PSODOSOR<1)!(PSOFREQ>1440)
- Begin DoDot:1
- +14 ;Different calculation for doses of less than one QTY (e.g., 1/2 tablet) OR frequency less than every 24hrs (e.g., every 72hrs)
- +15 IF PSOFREQ
- IF (((PSOOLDDS*(1440/PSOFREQ))*PSODOSOR)+.9\1)'=PSOOLDQT
- SET UPDQTY=0
- End DoDot:1
- +16 IF '$TEST
- Begin DoDot:1
- +17 ;Checking whether current QTY was previously calculated
- +18 IF ((NEWQTY/PSONEWDS)'=(PSOOLDQT/PSOOLDDS))
- SET UPDQTY=0
- End DoDot:1
- +19 ;
- +20 ;QTY is increasing for a CS Rx/Order, so don't update with new QTY
- +21 IF ($GET(PSOFDR)&$PIECE($GET(OR0),"^",24)&(NEWQTY>PSOOLDQT))
- SET UPDQTY=0
- +22 ;
- +23 IF 'UPDQTY
- Begin DoDot:1
- +24 WRITE !!,"The Quantity (",PSOOLDQT,") has not been changed."
- +25 WRITE !,"Please review and update it if necessary.",!,$CHAR(7)
- +26 NEW DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- WRITE !
- End DoDot:1
- +27 QUIT UPDQTY
- +28 ;
- SCHFREQ() ; Returns the Frequency (in minutes) for the schedule
- +1 ; Output: SCHFREQ - Schedule Frequency (in minutes)
- +2 NEW SCHED,SCHEDIEN
- +3 SET SCHED=$GET(PSOQX("SCHEDULE",1))
- IF SCHED=""
- QUIT 0
- +4 SET SCHEDIEN=$ORDER(^PS(51.1,"B",SCHED,0))
- IF SCHEDIEN
- QUIT $$GET1^DIQ(51.1,SCHEDIEN,2)
- +5 SET SCHEDIEN=$ORDER(^PS(51,"B",SCHED,0))
- IF SCHEDIEN
- QUIT $$GET1^DIQ(51,SCHEDIEN,31)
- +6 QUIT 0
- +7 ;
- PRN() ; Returns if the Schedule is PRN (1) or not (0)
- +1 NEW PRN,SCH
- SET PRN=0
- +2 FOR SCH=1:1
- if '$DATA(PSOQX("SCHEDULE",SCH))
- QUIT
- IF $GET(PSOQX("SCHEDULE",SCH))["PRN"
- SET PRN=1
- QUIT
- +3 QUIT PRN
- +4 ;
- UPPER(PSOSCUP) ;
- +1 QUIT $TRANSLATE(PSOSCUP,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")