PSOVEXR1 ;BIRM/KML - PHARMACY TELEPHONE REFILLS - CONTINUED; May 22, 2026@11:20
;;7.0;OUTPATIENT PHARMACY;**653,832**;Dec 1997;Build 4
;
PSOBLD ; This will transfer entries from the vendor daily telephone refill requests global when the pharmacy audio refills option is accessed.
;VEXHRX(19080,PSOSITE,"PSODFN-PSORXIEN")=PSORDT_"^"_PSOSTAT_"^"_PSOP3_"^"_PSOP4_"^"_PSOORF_"^"_PSORSLT_"^"_PSOUSER_"^"_PSOPRF
;each time the option is accessed it will add new RXs to the class I ^PS(52.444 file.
;below is a breakdown of the vendor ^VEXHRX(19080 global contents.
;PSOSITE= Outpatient site number of refill request i.e. 442 for cheyenne VAMC
;PSODFN=patient dfn from file #2
;PSORXIEN=the ien of the prescription file. Not the prescription #. the prescription number is actually piece one of the PSRX global
;PSORDT=the date processed needs to also be set back into vexhrx for clean up.
;PSOSTAT=status of "NOT FILLED"
;PSOP3=PIECE NOT USED
;PSOP4=PIECE NOT USED
;PSOORF=ORDER RENEW FLAG - SET OF CODES 'N' for NoN Renewable or 'U' unsigned orders allowed and 'I' Incomplete because Unsigned orders not allowed.
;PSORSLT=RENEW PROCESSING RESULT - ORAREN SET OF CODES '0' is processing problem., '1' for OK, '2' for user stopped, '3' not from primary care provider. '5' provider on order terminated no one to send order to.
;PSOUSER=IEN OF NEW PERSON file (#200). User that processed the order, i.e. Auto refills could be USER,AUDIOCARE
;PSOPRF=PROVIDER RENEW FLAG - 'P' FOR restricts renewals to THE PATIENTS PRIMARY CARE PROVIDER; 'A' FOR ANY PROVIDER CAN RENEW;
N PSOORF,PSODFN,PSODFNRX,PSOGET,PSOPRF,PSORDT,PSORSLT,PSOUSER,PSOSITE,PSOSITID,PSOXCNT,PSOXPTRN
K FDA,PSOERR
S (PSOORF,PSOPRF,PSORSLT,PSORDT,PSOSTAT,PSOUSER)=""
K ^XTMP("PSOVEXRX",$J)
L +^XTMP("PSOVEXRX"):5 D Q:'$T
. I '$T D Q
. . S QUIT=1
. . ;Performing $G in case another vendor process somehow sets this lock,
. . ;even though that is extremely unlikely.
. . N PSOSTR S PSOSTR=$G(^XTMP("PSOVEXRX"))
. . I PSOSTR="" D Q
. . . W !!,"Unknown process has the lock. Audit has not been set."
. . . W !,"Please try again later."
. . N PSOWHO S PSOWHO=$$NAME^XUSER($P(PSOSTR,"^"))
. . W !!,$S(PSOWHO'="":PSOWHO,1:$P(PSOSTR,"^"))," locked this option"
. . W !,$P($$FMTE^XLFDT($P(PSOSTR,U,2)),":",1,2)," with job number: ",$P(PSOSTR,U,3),"."
. . I PSOWHO]"" W !,"Please try again later or contact end user to exit the option." Q
. . ;Extremely unlikely that a process (not a user) is locking the option, but displaying text anyway.
. . W !,"Please try again later."
. ;Set audit of who, when, and job number when locked.
. S ^XTMP("PSOVEXRX")=DUZ_"^"_$$NOW^XLFDT_"^"_$J
;PSO*7.0*832: Adding zero node to adhere to ^XTMP rule. Previously was not set.
S ^XTMP("PSOVEXRX",0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^PSO PROCESS TELEPHONE REFILLS option"
M ^XTMP("PSOVEXRX",$J)=^VEXHRX(19080) ; populate XTMP with AUDIOCARE vendor array data for further processing
S PSOSITE=0 F S PSOSITE=$O(^XTMP("PSOVEXRX",$J,PSOSITE)) Q:'PSOSITE D
. S PSODFNRX=0 F S PSODFNRX=$O(^XTMP("PSOVEXRX",$J,PSOSITE,PSODFNRX)) Q:'PSODFNRX D
. . S PSODFN=$P(PSODFNRX,"-",1)
. . S PSORXIEN=$P(PSODFNRX,"-",2)
. . S PSOSITID=$P($G(^PSRX(PSORXIEN,2)),U,9)
. . I PSORXIEN Q:$D(^PS(52.444,"B",PSORXIEN)) ;This checks to see is a prescription ien is already recorded.
. . S PSOGET=$G(^XTMP("PSOVEXRX",$J,PSOSITE,PSODFNRX))
. . S:$D(PSOGET) PSORDT=$P(PSOGET,U,1),PSOSTAT=$P(PSOGET,U,2),PSOORF=$P(PSOGET,U,5),PSORSLT=$P(PSOGET,U,6),PSOUSER=$P(PSOGET,U,7),PSOPRF=$P(PSOGET,U,8) Q:$G(PSORDT)
. . ;QUIT ABOVE If a date is already in piece one of the vendor global means the order has been processed.
. . ;code below this line adds new RX information to the Class I file 52.444
. . S FDA(1,52.444,"?+1,",.01)=PSORXIEN
. . S FDA(1,52.444,"?+1,",1)=PSOSITID
. . S FDA(1,52.444,"?+1,",2)=PSODFN
. . I $D(PSOSTAT) S FDA(1,52.444,"?+1,",4)=PSOSTAT
. . I $D(PSOORF) S FDA(1,52.444,"?+1,",5)=PSOORF
. . I $D(PSORSLT) S FDA(1,52.444,"?+1,",6)=PSORSLT
. . I $G(PSOUSER) S FDA(1,52.444,"?+1,",7)=PSOUSER
. . I $D(PSOPRF) S FDA(1,52.444,"?+1,",8)=PSOPRF
. . D UPDATE^DIE("","FDA(1)",,"PSOERR")
. . W:$D(PSOERR) !,"Prescription Internal Record number "_PSORXIEN_" failed to UPDATE file 52.444"
Q
;
CLEAN ;delete completed records from the new file 52.444.
;scheduled to run daily
N PSORDT,PSORXEN
K ^XTMP("PSOVEXRX",$J)
;PSO*7.0*832: Add lock audit.
; If locked, no need to display a message since this is a background job.
L +^XTMP("PSOVEXRX"):5 D I '$T Q
. I $T S ^XTMP("PSOVEXRX")="PSO PURGE PROCESSED 52.444 option^"_$$NOW^XLFDT_"^"_$J
;PSO*7.0*832: Adding zero node to adhere to ^XTMP rule. Previously was not set.
S ^XTMP("PSOVEXRX",0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^PSO PURGE PROCESSED 52.444 option"
M ^XTMP("PSOVEXRX",$J)=^VEXHRX(19080) ; populate XTMP with AUDIOCARE vendor array data for further processing
D SETVEN
S PSORDT=0 F S PSORDT=$O(^PS(52.444,"E",PSORDT)) Q:'PSORDT D
. S PSORXEN=0 F S PSORXEN=$O(^PS(52.444,"E",PSORDT,PSORXEN)) Q:'PSORXEN D
. . S DIK="^PS(52.444,",DA=PSORXEN D ^DIK K DIK,DA
K XMY N XMDUZ,XMSUB,XMTEXT,XMT
S XMDUZ="AUTO,RENEWAL",XMY(DUZ)="",XMY("G.AUTORENEWAL")="",XMSUB="Purge PHARMACY TELEPHONE REFILLS file (#52.444)."
S XMT(1,0)="Purge of processed entries in the "
S XMT(2,0)="PHARMACY TELEPHONE REFILLS file (#52.444) completed."
S XMTEXT="XMT("
D ^XMD
Q
;
SETVEN ;adds fill date, status and processing result to vendor global to facilitate completion in their process.
N PSODATA,PSODFN,PSORDT,PSORSLT,PSORGET,PSORX,PSORXEN,PSORXIEN,PSOSITE,PSOSTAT
S PSOSITE=$$GET1^DIQ(4,$P(^XMB(1,1,"XUS"),"^",17),99,"I") ;ICR 10090 and 10091 retrieve parent institution for the site
S (PSOCNT,PSORDT)=0 F S PSORDT=$O(^PS(52.444,"E",PSORDT)) Q:'PSORDT D
. S PSORXEN=0 F S PSORXEN=$O(^PS(52.444,"E",PSORDT,PSORXEN)) Q:'PSORXEN D
. . S PSORGET=$G(^PS(52.444,PSORXEN,0))
. . S PSORXIEN=$P(PSORGET,U,1)
. . S PSOSTAT=$P(PSORGET,U,5),PSORSLT=$P(PSORGET,U,7)
. . S IENS=PSORXIEN_","
. . D GETS^DIQ(52,IENS,".01;2;6","","PSORX")
. . S PSODFN=$P(PSORGET,U,3)
. . S PSODATA=""_PSODFN_""_"-"_""_PSORXIEN_""
. . Q:'$D(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA))
. . Q:$P(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA),"^")
. . I $G(PRINT) W !,"RX #: "_$P(PSORX(52,IENS,".01"),U,1)_" RX IEN: "_IENS_" was marked processed in the ^VEXHRX Global. "
. . S $P(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA),"^")=PSORDT ;direct set required due to non fileman vendor global for Audiocare maintenance
. . I $D(PSOSTAT) S $P(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA),"^",2)=PSOSTAT ;direct set required due to non fileman vendor global Audiocare maintenance
. . I $G(PSORSLT)'="" S $P(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA),"^",6)=PSORSLT ;direct set required due to non fileman vendor global Audiocare maintenance
. . S PSOCNT=PSOCNT+1
M ^VEXHRX(19080)=^XTMP("PSOVEXRX",$J)
K ^XTMP("PSOVEXRX",$J)
L -^XTMP("PSOVEXRX")
;Deleting lock audit and stray zero node to prevent confusion during troubleshooting.
;Hesitant to kill just in case it would cause issues.
;The background process XQ XUTL $J NODES will clean these up periodically.
S ^XTMP("PSOVEXRX")=""
S ^XTMP("PSOVEXRX",0)=""
Q
;
TILDECHK(PSORXIEN,PSORXEN) ;check for the tilde character (~) in the free text dosage field of the medications instructions
; PSORXIEN = input - ien of RX in PRESCRIPTION file (#52)
; PSORXEN = input - ien of RX in PHARMACY TELEPHONE REFILLS file (#52.444)
; RSLT = return as output
N TILDECHK,IENS,I,J,RSLT,CS,DRGIEN
S IENS=PSORXIEN_","
D GETS^DIQ(52,IENS,"113*","","TILDECHK")
S DRGIEN=+$P($G(^PSRX(PSORXIEN,0)),U,6)
S CS=$$CSDRUG(DRGIEN)
S RSLT=0
S I=0 F S I=$O(TILDECHK(52.0113,I)) Q:I="" S J=0 F S J=$O(TILDECHK(52.0113,I,J)) Q:J="" I TILDECHK(52.0113,I,J)["~" S RSLT=1
I RSLT D
. S IENS=PSORXEN_","
. S FDA(52.444,IENS,3)=DT D FILE^DIE(,"FDA","PSOERR") ; update the entry with the date processed
S RSLT=RSLT_"^"_CS
Q RSLT
;
CSDRUG(IEN) ;Controlled Substance drug?
; Input: IEN - DRUG file (#50) pointer
;Output: $$CS - 1:YES / 0:NO
N DEA
Q:'IEN 0
S DEA=$P($G(^PSDRUG(IEN,0)),U,3)
I (DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOVEXR1 8311 printed Sep 17, 2026@21:22:20 Page 2
PSOVEXR1 ;BIRM/KML - PHARMACY TELEPHONE REFILLS - CONTINUED; May 22, 2026@11:20
+1 ;;7.0;OUTPATIENT PHARMACY;**653,832**;Dec 1997;Build 4
+2 ;
PSOBLD ; This will transfer entries from the vendor daily telephone refill requests global when the pharmacy audio refills option is accessed.
+1 ;VEXHRX(19080,PSOSITE,"PSODFN-PSORXIEN")=PSORDT_"^"_PSOSTAT_"^"_PSOP3_"^"_PSOP4_"^"_PSOORF_"^"_PSORSLT_"^"_PSOUSER_"^"_PSOPRF
+2 ;each time the option is accessed it will add new RXs to the class I ^PS(52.444 file.
+3 ;below is a breakdown of the vendor ^VEXHRX(19080 global contents.
+4 ;PSOSITE= Outpatient site number of refill request i.e. 442 for cheyenne VAMC
+5 ;PSODFN=patient dfn from file #2
+6 ;PSORXIEN=the ien of the prescription file. Not the prescription #. the prescription number is actually piece one of the PSRX global
+7 ;PSORDT=the date processed needs to also be set back into vexhrx for clean up.
+8 ;PSOSTAT=status of "NOT FILLED"
+9 ;PSOP3=PIECE NOT USED
+10 ;PSOP4=PIECE NOT USED
+11 ;PSOORF=ORDER RENEW FLAG - SET OF CODES 'N' for NoN Renewable or 'U' unsigned orders allowed and 'I' Incomplete because Unsigned orders not allowed.
+12 ;PSORSLT=RENEW PROCESSING RESULT - ORAREN SET OF CODES '0' is processing problem., '1' for OK, '2' for user stopped, '3' not from primary care provider. '5' provider on order terminated no one to send order to.
+13 ;PSOUSER=IEN OF NEW PERSON file (#200). User that processed the order, i.e. Auto refills could be USER,AUDIOCARE
+14 ;PSOPRF=PROVIDER RENEW FLAG - 'P' FOR restricts renewals to THE PATIENTS PRIMARY CARE PROVIDER; 'A' FOR ANY PROVIDER CAN RENEW;
+15 NEW PSOORF,PSODFN,PSODFNRX,PSOGET,PSOPRF,PSORDT,PSORSLT,PSOUSER,PSOSITE,PSOSITID,PSOXCNT,PSOXPTRN
+16 KILL FDA,PSOERR
+17 SET (PSOORF,PSOPRF,PSORSLT,PSORDT,PSOSTAT,PSOUSER)=""
+18 KILL ^XTMP("PSOVEXRX",$JOB)
+19 LOCK +^XTMP("PSOVEXRX"):5
Begin DoDot:1
+20 IF '$TEST
Begin DoDot:2
+21 SET QUIT=1
+22 ;Performing $G in case another vendor process somehow sets this lock,
+23 ;even though that is extremely unlikely.
+24 NEW PSOSTR
SET PSOSTR=$GET(^XTMP("PSOVEXRX"))
+25 IF PSOSTR=""
Begin DoDot:3
+26 WRITE !!,"Unknown process has the lock. Audit has not been set."
+27 WRITE !,"Please try again later."
End DoDot:3
QUIT
+28 NEW PSOWHO
SET PSOWHO=$$NAME^XUSER($PIECE(PSOSTR,"^"))
+29 WRITE !!,$SELECT(PSOWHO'="":PSOWHO,1:$PIECE(PSOSTR,"^"))," locked this option"
+30 WRITE !,$PIECE($$FMTE^XLFDT($PIECE(PSOSTR,U,2)),":",1,2)," with job number: ",$PIECE(PSOSTR,U,3),"."
+31 IF PSOWHO]""
WRITE !,"Please try again later or contact end user to exit the option."
QUIT
+32 ;Extremely unlikely that a process (not a user) is locking the option, but displaying text anyway.
+33 WRITE !,"Please try again later."
End DoDot:2
QUIT
+34 ;Set audit of who, when, and job number when locked.
+35 SET ^XTMP("PSOVEXRX")=DUZ_"^"_$$NOW^XLFDT_"^"_$J
End DoDot:1
if '$TEST
QUIT
+36 ;PSO*7.0*832: Adding zero node to adhere to ^XTMP rule. Previously was not set.
+37 SET ^XTMP("PSOVEXRX",0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^PSO PROCESS TELEPHONE REFILLS option"
+38 ; populate XTMP with AUDIOCARE vendor array data for further processing
MERGE ^XTMP("PSOVEXRX",$JOB)=^VEXHRX(19080)
+39 SET PSOSITE=0
FOR
SET PSOSITE=$ORDER(^XTMP("PSOVEXRX",$JOB,PSOSITE))
if 'PSOSITE
QUIT
Begin DoDot:1
+40 SET PSODFNRX=0
FOR
SET PSODFNRX=$ORDER(^XTMP("PSOVEXRX",$JOB,PSOSITE,PSODFNRX))
if 'PSODFNRX
QUIT
Begin DoDot:2
+41 SET PSODFN=$PIECE(PSODFNRX,"-",1)
+42 SET PSORXIEN=$PIECE(PSODFNRX,"-",2)
+43 SET PSOSITID=$PIECE($GET(^PSRX(PSORXIEN,2)),U,9)
+44 ;This checks to see is a prescription ien is already recorded.
IF PSORXIEN
if $DATA(^PS(52.444,"B",PSORXIEN))
QUIT
+45 SET PSOGET=$GET(^XTMP("PSOVEXRX",$JOB,PSOSITE,PSODFNRX))
+46 if $DATA(PSOGET)
SET PSORDT=$PIECE(PSOGET,U,1)
SET PSOSTAT=$PIECE(PSOGET,U,2)
SET PSOORF=$PIECE(PSOGET,U,5)
SET PSORSLT=$PIECE(PSOGET,U,6)
SET PSOUSER=$PIECE(PSOGET,U,7)
SET PSOPRF=$PIECE(PSOGET,U,8)
if $GET(PSORDT)
QUIT
+47 ;QUIT ABOVE If a date is already in piece one of the vendor global means the order has been processed.
+48 ;code below this line adds new RX information to the Class I file 52.444
+49 SET FDA(1,52.444,"?+1,",.01)=PSORXIEN
+50 SET FDA(1,52.444,"?+1,",1)=PSOSITID
+51 SET FDA(1,52.444,"?+1,",2)=PSODFN
+52 IF $DATA(PSOSTAT)
SET FDA(1,52.444,"?+1,",4)=PSOSTAT
+53 IF $DATA(PSOORF)
SET FDA(1,52.444,"?+1,",5)=PSOORF
+54 IF $DATA(PSORSLT)
SET FDA(1,52.444,"?+1,",6)=PSORSLT
+55 IF $GET(PSOUSER)
SET FDA(1,52.444,"?+1,",7)=PSOUSER
+56 IF $DATA(PSOPRF)
SET FDA(1,52.444,"?+1,",8)=PSOPRF
+57 DO UPDATE^DIE("","FDA(1)",,"PSOERR")
+58 if $DATA(PSOERR)
WRITE !,"Prescription Internal Record number "_PSORXIEN_" failed to UPDATE file 52.444"
End DoDot:2
End DoDot:1
+59 QUIT
+60 ;
CLEAN ;delete completed records from the new file 52.444.
+1 ;scheduled to run daily
+2 NEW PSORDT,PSORXEN
+3 KILL ^XTMP("PSOVEXRX",$JOB)
+4 ;PSO*7.0*832: Add lock audit.
+5 ; If locked, no need to display a message since this is a background job.
+6 LOCK +^XTMP("PSOVEXRX"):5
Begin DoDot:1
+7 IF $TEST
SET ^XTMP("PSOVEXRX")="PSO PURGE PROCESSED 52.444 option^"_$$NOW^XLFDT_"^"_$J
End DoDot:1
IF '$TEST
QUIT
+8 ;PSO*7.0*832: Adding zero node to adhere to ^XTMP rule. Previously was not set.
+9 SET ^XTMP("PSOVEXRX",0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^PSO PURGE PROCESSED 52.444 option"
+10 ; populate XTMP with AUDIOCARE vendor array data for further processing
MERGE ^XTMP("PSOVEXRX",$JOB)=^VEXHRX(19080)
+11 DO SETVEN
+12 SET PSORDT=0
FOR
SET PSORDT=$ORDER(^PS(52.444,"E",PSORDT))
if 'PSORDT
QUIT
Begin DoDot:1
+13 SET PSORXEN=0
FOR
SET PSORXEN=$ORDER(^PS(52.444,"E",PSORDT,PSORXEN))
if 'PSORXEN
QUIT
Begin DoDot:2
+14 SET DIK="^PS(52.444,"
SET DA=PSORXEN
DO ^DIK
KILL DIK,DA
End DoDot:2
End DoDot:1
+15 KILL XMY
NEW XMDUZ,XMSUB,XMTEXT,XMT
+16 SET XMDUZ="AUTO,RENEWAL"
SET XMY(DUZ)=""
SET XMY("G.AUTORENEWAL")=""
SET XMSUB="Purge PHARMACY TELEPHONE REFILLS file (#52.444)."
+17 SET XMT(1,0)="Purge of processed entries in the "
+18 SET XMT(2,0)="PHARMACY TELEPHONE REFILLS file (#52.444) completed."
+19 SET XMTEXT="XMT("
+20 DO ^XMD
+21 QUIT
+22 ;
SETVEN ;adds fill date, status and processing result to vendor global to facilitate completion in their process.
+1 NEW PSODATA,PSODFN,PSORDT,PSORSLT,PSORGET,PSORX,PSORXEN,PSORXIEN,PSOSITE,PSOSTAT
+2 ;ICR 10090 and 10091 retrieve parent institution for the site
SET PSOSITE=$$GET1^DIQ(4,$PIECE(^XMB(1,1,"XUS"),"^",17),99,"I")
+3 SET (PSOCNT,PSORDT)=0
FOR
SET PSORDT=$ORDER(^PS(52.444,"E",PSORDT))
if 'PSORDT
QUIT
Begin DoDot:1
+4 SET PSORXEN=0
FOR
SET PSORXEN=$ORDER(^PS(52.444,"E",PSORDT,PSORXEN))
if 'PSORXEN
QUIT
Begin DoDot:2
+5 SET PSORGET=$GET(^PS(52.444,PSORXEN,0))
+6 SET PSORXIEN=$PIECE(PSORGET,U,1)
+7 SET PSOSTAT=$PIECE(PSORGET,U,5)
SET PSORSLT=$PIECE(PSORGET,U,7)
+8 SET IENS=PSORXIEN_","
+9 DO GETS^DIQ(52,IENS,".01;2;6","","PSORX")
+10 SET PSODFN=$PIECE(PSORGET,U,3)
+11 SET PSODATA=""_PSODFN_""_"-"_""_PSORXIEN_""
+12 if '$DATA(^XTMP("PSOVEXRX",$JOB,PSOSITE,PSODATA))
QUIT
+13 if $PIECE(^XTMP("PSOVEXRX",$JOB,PSOSITE,PSODATA),"^")
QUIT
+14 IF $GET(PRINT)
WRITE !,"RX #: "_$PIECE(PSORX(52,IENS,".01"),U,1)_" RX IEN: "_IENS_" was marked processed in the ^VEXHRX Global. "
+15 ;direct set required due to non fileman vendor global for Audiocare maintenance
SET $PIECE(^XTMP("PSOVEXRX",$JOB,PSOSITE,PSODATA),"^")=PSORDT
+16 ;direct set required due to non fileman vendor global Audiocare maintenance
IF $DATA(PSOSTAT)
SET $PIECE(^XTMP("PSOVEXRX",$JOB,PSOSITE,PSODATA),"^",2)=PSOSTAT
+17 ;direct set required due to non fileman vendor global Audiocare maintenance
IF $GET(PSORSLT)'=""
SET $PIECE(^XTMP("PSOVEXRX",$JOB,PSOSITE,PSODATA),"^",6)=PSORSLT
+18 SET PSOCNT=PSOCNT+1
End DoDot:2
End DoDot:1
+19 MERGE ^VEXHRX(19080)=^XTMP("PSOVEXRX",$JOB)
+20 KILL ^XTMP("PSOVEXRX",$JOB)
+21 LOCK -^XTMP("PSOVEXRX")
+22 ;Deleting lock audit and stray zero node to prevent confusion during troubleshooting.
+23 ;Hesitant to kill just in case it would cause issues.
+24 ;The background process XQ XUTL $J NODES will clean these up periodically.
+25 SET ^XTMP("PSOVEXRX")=""
+26 SET ^XTMP("PSOVEXRX",0)=""
+27 QUIT
+28 ;
TILDECHK(PSORXIEN,PSORXEN) ;check for the tilde character (~) in the free text dosage field of the medications instructions
+1 ; PSORXIEN = input - ien of RX in PRESCRIPTION file (#52)
+2 ; PSORXEN = input - ien of RX in PHARMACY TELEPHONE REFILLS file (#52.444)
+3 ; RSLT = return as output
+4 NEW TILDECHK,IENS,I,J,RSLT,CS,DRGIEN
+5 SET IENS=PSORXIEN_","
+6 DO GETS^DIQ(52,IENS,"113*","","TILDECHK")
+7 SET DRGIEN=+$PIECE($GET(^PSRX(PSORXIEN,0)),U,6)
+8 SET CS=$$CSDRUG(DRGIEN)
+9 SET RSLT=0
+10 SET I=0
FOR
SET I=$ORDER(TILDECHK(52.0113,I))
if I=""
QUIT
SET J=0
FOR
SET J=$ORDER(TILDECHK(52.0113,I,J))
if J=""
QUIT
IF TILDECHK(52.0113,I,J)["~"
SET RSLT=1
+11 IF RSLT
Begin DoDot:1
+12 SET IENS=PSORXEN_","
+13 ; update the entry with the date processed
SET FDA(52.444,IENS,3)=DT
DO FILE^DIE(,"FDA","PSOERR")
End DoDot:1
+14 SET RSLT=RSLT_"^"_CS
+15 QUIT RSLT
+16 ;
CSDRUG(IEN) ;Controlled Substance drug?
+1 ; Input: IEN - DRUG file (#50) pointer
+2 ;Output: $$CS - 1:YES / 0:NO
+3 NEW DEA
+4 if 'IEN
QUIT 0
+5 SET DEA=$PIECE($GET(^PSDRUG(IEN,0)),U,3)
+6 IF (DEA["2")!(DEA["3")!(DEA["4")!(DEA["5")
QUIT 1
+7 QUIT 0
+8 ;
