PSO7P289 ;CMF - PSO*7*289 Convert file 52.25/field 24 to pointer ;06/09/2008
;;7.0;OUTPATIENT PHARMACY;**289**;May 2008;Build 107
;;Reference to 9002313.25 supported by DBIA 5064
;
N NAMSP,PATCH,JOBN,JOBDUZ,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
S NAMSP=$$NAMSP
S JOBN="Clarification Code Conversion"
S JOBDUZ=$S($G(DUZ)'="":DUZ,1:.5)
S PATCH="PSO*7*289"
;
L +^XTMP(NAMSP):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T D Q
. D BMES^XPDUTL(JOBN_" job is already running. Halting...")
. D MES^XPDUTL("")
. D QUIT
;
I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,JOBN_", "_PATCH,90) ;90 day life
S QUIT=0
;
I $G(^XTMP(NAMSP,0,"STATUS"))["Completed" D Q
. D BMES^XPDUTL("This conversion has been run before to completion on ")
. D MES^XPDUTL($$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"STATUS")),"^",2))_".")
. D MES^XPDUTL("If you want to run it again, do 'RESTORE^PSO7P289', then")
. D MES^XPDUTL("the global subscript ^XTMP('"_NAMSP_"') must be")
. D MES^XPDUTL("killed prior to doing so.")
. D MES^XPDUTL("")
. D MES^XPDUTL("It is strongly recommended you not do this.")
. D QUIT
;
;I '$D(XPDQUES("POS1")) D I 'ZTDTH D QUIT Q
;. K DIR
;. S DIR("A")="Enter when to Queue the "_JOBN_" to run."
;. S DIR("B")="NOW"
;. S DIR(0)="D^::%DT"
;. S DIR("?")="Enter when to start the job. This should be a time after the install has completed."
;. D ^DIR
;. I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S ZTDTH="" Q
;. S ZTDTH=$$FMTH^XLFDT(Y)
;
;I $D(XPDQUES("POS1")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS1"))
S ZTDTH=$$FMTH^XLFDT($$NOW^XLFDT)
D BMES^XPDUTL("=============================================================")
D MES^XPDUTL("Queuing background job for "_JOBN_"...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
D MES^XPDUTL("==============================================================")
I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
;
S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
;
I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
E D
. S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
;
S ZTRTN="EN^PSO7P289"
S ZTIO=""
S ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
S ZTSAVE("JOBN")=""
S ZTSAVE("JOBDUZ")=""
L -^XTMP(NAMSP)
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
D BMES^XPDUTL("")
Q
QUIT ;
L -^XTMP(NAMSP)
;
Q
;
STATUS ;show status of job running
I $$ST D
. W !,"Currently processing:"
. I $G(^XTMP($$NAMSP,0,"STATUS"))["Completed" D Q
. . W !,"Completed on ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"STATUS")),"^",2)),!
. W !?5,"Rx being processed > ",$$GETD0
. W !?5," Reject being processed > ",$$GETD1
E D
.I $G(^XTMP($$NAMSP,0,"STATUS"))["Completed" D
.. W !,"Completed on ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"STATUS")),"^",2)),!
Q
;
STOP ;stop job command
I $$ST D SETSTOP(1) D
. W !,"CLARIFICATION CODE CONVERSION Job - set to STOP Soon"
. W !!,"Check TASKMAN or Status to ensure it has stopped..."
. W !," (D STATUS^PSO7P289)"
Q
ST() ;status
L +^XTMP($$NAMSP):3 I $T D Q 0
. L -^XTMP($$NAMSP)
. W !,"*** NOT CURRENTLY RUNNING! ***",!
Q 1
;
INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
N BEGDT,PURGDT
S BEGDT=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
Q
;
NAMSP() ;
Q $T(+0)
;
EN ;
D CONVERT
D REJECT
Q
;
CONVERT ;
Q:$P($G(^XTMP($$NAMSP,0,"STATUS")),U)="In Process"
Q:$P($G(^XTMP($$NAMSP,0,"STATUS")),U)="Completed"
D SETD0(0)
D SETD1(0)
D SETSTOP(0)
D SETCWS
S ^XTMP($$NAMSP,0,"STATUS")="In Process"_U_$$NOW^XLFDT
S ^XTMP($$NAMSP,0,"JOBDUZ")=$G(JOBDUZ)
S ^XTMP($$NAMSP,0,"JOBN")=$G(JOBN)
RESUME ;
N RXIEN,REJIEN,OLDCODE,NEWCODE,NEWCODEE,DIE,DA,DR
S RXIEN=$$GETD0
F S RXIEN=$O(^PSRX(RXIEN)) Q:'RXIEN!($$GETSTOP()) D
.D SETD0(RXIEN)
.D SETD1(0)
.S REJIEN=$$GETD1
.F S REJIEN=$O(^PSRX(RXIEN,"REJ",REJIEN)) Q:'REJIEN D
..D SETD1(REJIEN)
..S OLDCODE=$P(^PSRX(RXIEN,"REJ",REJIEN,0),U,15)
..Q:OLDCODE=""
..S NEWCODE=$$GETCW(OLDCODE)
..S NEWCODEE=$$GET1^DIQ(9002313.25,NEWCODE,.01)
..S DIE="^PSRX("_RXIEN_","_"""REJ"""_",",DA(1)=RXIEN,DA=REJIEN,DR="24///"_NEWCODEE D ^DIE
..S ^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN)=OLDCODE_U_NEWCODE
I '$$GETSTOP() D
.S ^XTMP($$NAMSP,0,"STATUS")="Completed"_U_$$NOW^XLFDT
.D NOTIFY
Q
;
REJECT ;
N ERR
D RESCH^XUTMOPT("PSO REJECTS BACKGROUND MESSAGE",$$FMADD^XLFDT($$NOW^XLFDT,1),"","24H","L",.ERR)
Q
;
NOTIFY ; build mail message
N XMSUB,XMDUZ,XMTEXT,XMY,I,RXIEN,REJIEN,RX,OLDVALUE,NEWVALUE,NEWDESC
S XMSUB="PSO*7*289 Clarification Code Conversion Results"
S XMDUZ="OUTPATIENT PHARMACY PACKAGE"
S XMTEXT="^TMP($J,""PSO7P289"",""NOTIFY"","
S XMY(^XTMP($$NAMSP,0,"JOBDUZ"))=""
K ^TMP($J,"PSO7P289","NOTIFY")
S ^TMP($J,"PSO7P289","NOTIFY",1)="The Clarification Code Conversion queued install routine for patch"
S ^TMP($J,"PSO7P289","NOTIFY",2)="PSO*7*289 has completed. This message lists edited prescriptions."
S ^TMP($J,"PSO7P289","NOTIFY",3)=""
S ^TMP($J,"PSO7P289","NOTIFY",4)="The 'Old Value' column contains the internal set of codes value for"
S ^TMP($J,"PSO7P289","NOTIFY",5)="CLARIFICATION CODE field (#24) of REJECT INFO Multiple (#52.25) of"
S ^TMP($J,"PSO7P289","NOTIFY",6)="PRESCRIPTION file (#52). Possible old values consist of:"
S ^TMP($J,"PSO7P289","NOTIFY",7)=""
S ^TMP($J,"PSO7P289","NOTIFY",8)=$$RJ^XLFSTR("CODE",10)_" DESCRIPTION"
S ^TMP($J,"PSO7P289","NOTIFY",9)=$$RJ^XLFSTR("====",10)_" ======================="
S ^TMP($J,"PSO7P289","NOTIFY",10)=$$RJ^XLFSTR("0",10)_" FOR NOT SPECIFIED"
S ^TMP($J,"PSO7P289","NOTIFY",11)=$$RJ^XLFSTR("1",10)_" NO OVERRIDE"
S ^TMP($J,"PSO7P289","NOTIFY",12)=$$RJ^XLFSTR("2",10)_" OTHER OVERRIDE"
S ^TMP($J,"PSO7P289","NOTIFY",13)=$$RJ^XLFSTR("3",10)_" VACATION SUPPLY"
S ^TMP($J,"PSO7P289","NOTIFY",14)=$$RJ^XLFSTR("4",10)_" LOST PRESCRIPTION"
S ^TMP($J,"PSO7P289","NOTIFY",15)=$$RJ^XLFSTR("5",10)_" THERAPY CHANGE"
S ^TMP($J,"PSO7P289","NOTIFY",16)=$$RJ^XLFSTR("6",10)_" STARTER DOSE"
S ^TMP($J,"PSO7P289","NOTIFY",17)=$$RJ^XLFSTR("7",10)_" MEDICALY NECESSARY"
S ^TMP($J,"PSO7P289","NOTIFY",18)=$$RJ^XLFSTR("8",10)_" PROCESS COMPOUND"
S ^TMP($J,"PSO7P289","NOTIFY",19)=$$RJ^XLFSTR("9",10)_" ENCOUNTERS"
S ^TMP($J,"PSO7P289","NOTIFY",20)=""
S ^TMP($J,"PSO7P289","NOTIFY",21)="The 'New Value' column is the equivalent pointer to file 9002313.25."
S ^TMP($J,"PSO7P289","NOTIFY",22)="The 'New Value Description' describes the value."
S ^TMP($J,"PSO7P289","NOTIFY",23)=""
S ^TMP($J,"PSO7P289","NOTIFY",24)=$$RJ^XLFSTR("Reject",28)_$$RJ^XLFSTR("Old",7)_$$RJ^XLFSTR("New",7)
S ^TMP($J,"PSO7P289","NOTIFY",25)=$$RJ^XLFSTR("RXien",10)_$$RJ^XLFSTR("RX#",10)_$$RJ^XLFSTR("Ien",8)_$$RJ^XLFSTR("Value",7)_$$RJ^XLFSTR("Value",7)_" New Value Description"
S ^TMP($J,"PSO7P289","NOTIFY",26)="============================================================================="
S I=26
S RXIEN=0
F S RXIEN=$O(^XTMP($$NAMSP,0,"LOG",RXIEN)) Q:'RXIEN D
.S RX=$$GET1^DIQ(52,RXIEN,.01)
.S REJIEN=0
.F S REJIEN=$O(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN)) Q:'REJIEN D
..S I=I+1
..S OLDVALUE=$P(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",1)
..S NEWVALUE=$P(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",2)
..S NEWDESC=$$GET1^DIQ(9002313.25,NEWVALUE,.02)
..S ^TMP($J,"PSO7P289","NOTIFY",I)=$$RJ^XLFSTR(RXIEN,10)_$$RJ^XLFSTR(RX,10)_$$RJ^XLFSTR(REJIEN,8)_$$RJ^XLFSTR(OLDVALUE,7)_$$RJ^XLFSTR(NEWVALUE,7)_" "_NEWDESC
D ^XMD
K ^TMP($J,"PSO7P289","NOTIFY")
Q
;;
RESTORE ; restore old set of code values (backstop)
N RXIEN,REJIEN,OLDVALUE,DIE,DA,DR
S RXIEN=0
F S RXIEN=$O(^XTMP($$NAMSP,0,"LOG",RXIEN)) Q:'RXIEN D
.S REJIEN=0
.F S REJIEN=$O(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN)) Q:'REJIEN D
..S OLDVALUE=$P(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",1)
..S DIE="^PSRX("_RXIEN_","_"""REJ"""_",",DA(1)=RXIEN,DA=REJIEN,DR="24///"_OLDVALUE D ^DIE
K ^XTMP($$NAMSP,0,"LOG")
Q
;;
SETD0(VALUE) ;;
S ^XTMP($$NAMSP,0,"LASTD0")=VALUE
Q
;
GETD0() ;;
Q ^XTMP($$NAMSP,0,"LASTD0")
;
SETD1(VALUE) ;;
S ^XTMP($$NAMSP,0,"LASTD1")=VALUE
Q
;
GETD1() ;
Q ^XTMP($$NAMSP,0,"LASTD1")
;
SETCWS ;set cross-walk values
;;'0' FOR NOT SPECIFIED;
;;'1' FOR NO OVERRIDE;
;;'2' FOR OTHER OVERRIDE;
;;'3' FOR VACATION SUPPLY;
;;'4' FOR LOST PRESCRIPTION;
;;'5' FOR THERAPY CHANGE;
;;'6' FOR STARTER DOSE;
;;'7' FOR MEDICALLY NECESSARY;
;;'8' FOR PROCESS COMPOUND;
;;'9' FOR ENCOUNTERS;
;;'99' FOR OTHER;
N I
F I=0:1:9,99 D SETCW(I)
Q
;;
SETCW(VALUE) ;;
N POINTER
S POINTER=$O(^BPS(9002313.25,"B",VALUE,0))
S ^XTMP($$NAMSP,0,"CW",VALUE)=POINTER
;;
GETCW(VALUE) ;get cross-walk value
I $G(VALUE)="" Q ""
Q $G(^XTMP($$NAMSP,0,"CW",VALUE))
;;
SETSTOP(VALUE) ;;
S ^XTMP($$NAMSP,0,"STOP")=VALUE
S:+VALUE ^XTMP($$NAMSP,0,"STATUS")="Stopped"_U_$$NOW^XLFDT
Q
;;
GETSTOP() ;
Q ^XTMP($$NAMSP,0,"STOP")
;;
DESP ;delete ePharmacy site parameter file if it exists
;; This utility is used a pre-install routine for PSO*7*289 patch to delete file 52.86 if it
;; exists so that the security parameters on the file may be updated to allow user read access.
Q:'$D(^PS(52.86))
D MES^XPDUTL(" ")
D MES^XPDUTL("Updating security parameters for ePharmacy Site Parameter file (#52.86).")
D MES^XPDUTL(" ")
S DIU="52.86",DIU(0)="E" D EN^DIU2 K DIU
D MES^XPDUTL("Recreating the DATA DICTIONARY... File 52.86 update is complete.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7P289 9794 printed Nov 22, 2024@17:33:44 Page 2
PSO7P289 ;CMF - PSO*7*289 Convert file 52.25/field 24 to pointer ;06/09/2008
+1 ;;7.0;OUTPATIENT PHARMACY;**289**;May 2008;Build 107
+2 ;;Reference to 9002313.25 supported by DBIA 5064
+3 ;
+4 NEW NAMSP,PATCH,JOBN,JOBDUZ,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
+5 SET NAMSP=$$NAMSP
+6 SET JOBN="Clarification Code Conversion"
+7 SET JOBDUZ=$SELECT($GET(DUZ)'="":DUZ,1:.5)
+8 SET PATCH="PSO*7*289"
+9 ;
+10 LOCK +^XTMP(NAMSP):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
Begin DoDot:1
+11 DO BMES^XPDUTL(JOBN_" job is already running. Halting...")
+12 DO MES^XPDUTL("")
+13 DO QUIT
End DoDot:1
QUIT
+14 ;
+15 ;90 day life
IF '$DATA(^XTMP(NAMSP))
DO INITXTMP(NAMSP,JOBN_", "_PATCH,90)
+16 SET QUIT=0
+17 ;
+18 IF $GET(^XTMP(NAMSP,0,"STATUS"))["Completed"
Begin DoDot:1
+19 DO BMES^XPDUTL("This conversion has been run before to completion on ")
+20 DO MES^XPDUTL($$FMTE^XLFDT($PIECE($GET(^XTMP(NAMSP,0,"STATUS")),"^",2))_".")
+21 DO MES^XPDUTL("If you want to run it again, do 'RESTORE^PSO7P289', then")
+22 DO MES^XPDUTL("the global subscript ^XTMP('"_NAMSP_"') must be")
+23 DO MES^XPDUTL("killed prior to doing so.")
+24 DO MES^XPDUTL("")
+25 DO MES^XPDUTL("It is strongly recommended you not do this.")
+26 DO QUIT
End DoDot:1
QUIT
+27 ;
+28 ;I '$D(XPDQUES("POS1")) D I 'ZTDTH D QUIT Q
+29 ;. K DIR
+30 ;. S DIR("A")="Enter when to Queue the "_JOBN_" to run."
+31 ;. S DIR("B")="NOW"
+32 ;. S DIR(0)="D^::%DT"
+33 ;. S DIR("?")="Enter when to start the job. This should be a time after the install has completed."
+34 ;. D ^DIR
+35 ;. I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S ZTDTH="" Q
+36 ;. S ZTDTH=$$FMTH^XLFDT(Y)
+37 ;
+38 ;I $D(XPDQUES("POS1")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS1"))
+39 SET ZTDTH=$$FMTH^XLFDT($$NOW^XLFDT)
+40 DO BMES^XPDUTL("=============================================================")
+41 DO MES^XPDUTL("Queuing background job for "_JOBN_"...")
+42 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+43 DO MES^XPDUTL("==============================================================")
+44 IF ZTDTH=""
DO BMES^XPDUTL(JOBN_" NOT QUEUED")
DO QUIT
QUIT
+45 ;
+46 if $DATA(^XTMP(NAMSP,0,"LAST"))
SET ^XTMP(NAMSP,0,"ZAUDIT",$HOROLOG)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
+47 ;
+48 IF $PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^")="STOP"
Begin DoDot:1
+49 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
End DoDot:1
+50 IF '$TEST
Begin DoDot:1
+51 SET ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
End DoDot:1
+52 ;
+53 SET ZTRTN="EN^PSO7P289"
+54 SET ZTIO=""
+55 SET ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
+56 SET ZTSAVE("JOBN")=""
+57 SET ZTSAVE("JOBDUZ")=""
+58 LOCK -^XTMP(NAMSP)
+59 DO ^%ZTLOAD
+60 if $DATA(ZTSK)
Begin DoDot:1
+61 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+62 DO BMES^XPDUTL("")
End DoDot:1
+63 DO BMES^XPDUTL("")
+64 QUIT
QUIT ;
+1 LOCK -^XTMP(NAMSP)
+2 ;
+3 QUIT
+4 ;
STATUS ;show status of job running
+1 IF $$ST
Begin DoDot:1
+2 WRITE !,"Currently processing:"
+3 IF $GET(^XTMP($$NAMSP,0,"STATUS"))["Completed"
Begin DoDot:2
+4 WRITE !,"Completed on ",$$FMTE^XLFDT($PIECE($GET(^XTMP($$NAMSP,0,"STATUS")),"^",2)),!
End DoDot:2
QUIT
+5 WRITE !?5,"Rx being processed > ",$$GETD0
+6 WRITE !?5," Reject being processed > ",$$GETD1
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 IF $GET(^XTMP($$NAMSP,0,"STATUS"))["Completed"
Begin DoDot:2
+9 WRITE !,"Completed on ",$$FMTE^XLFDT($PIECE($GET(^XTMP($$NAMSP,0,"STATUS")),"^",2)),!
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
STOP ;stop job command
+1 IF $$ST
DO SETSTOP(1)
Begin DoDot:1
+2 WRITE !,"CLARIFICATION CODE CONVERSION Job - set to STOP Soon"
+3 WRITE !!,"Check TASKMAN or Status to ensure it has stopped..."
+4 WRITE !," (D STATUS^PSO7P289)"
End DoDot:1
+5 QUIT
ST() ;status
+1 LOCK +^XTMP($$NAMSP):3
IF $TEST
Begin DoDot:1
+2 LOCK -^XTMP($$NAMSP)
+3 WRITE !,"*** NOT CURRENTLY RUNNING! ***",!
End DoDot:1
QUIT 0
+4 QUIT 1
+5 ;
INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
+1 NEW BEGDT,PURGDT
+2 SET BEGDT=$$NOW^XLFDT()
+3 SET PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
+4 SET ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
+5 QUIT
+6 ;
NAMSP() ;
+1 QUIT $TEXT(+0)
+2 ;
EN ;
+1 DO CONVERT
+2 DO REJECT
+3 QUIT
+4 ;
CONVERT ;
+1 if $PIECE($GET(^XTMP($$NAMSP,0,"STATUS")),U)="In Process"
QUIT
+2 if $PIECE($GET(^XTMP($$NAMSP,0,"STATUS")),U)="Completed"
QUIT
+3 DO SETD0(0)
+4 DO SETD1(0)
+5 DO SETSTOP(0)
+6 DO SETCWS
+7 SET ^XTMP($$NAMSP,0,"STATUS")="In Process"_U_$$NOW^XLFDT
+8 SET ^XTMP($$NAMSP,0,"JOBDUZ")=$GET(JOBDUZ)
+9 SET ^XTMP($$NAMSP,0,"JOBN")=$GET(JOBN)
RESUME ;
+1 NEW RXIEN,REJIEN,OLDCODE,NEWCODE,NEWCODEE,DIE,DA,DR
+2 SET RXIEN=$$GETD0
+3 FOR
SET RXIEN=$ORDER(^PSRX(RXIEN))
if 'RXIEN!($$GETSTOP())
QUIT
Begin DoDot:1
+4 DO SETD0(RXIEN)
+5 DO SETD1(0)
+6 SET REJIEN=$$GETD1
+7 FOR
SET REJIEN=$ORDER(^PSRX(RXIEN,"REJ",REJIEN))
if 'REJIEN
QUIT
Begin DoDot:2
+8 DO SETD1(REJIEN)
+9 SET OLDCODE=$PIECE(^PSRX(RXIEN,"REJ",REJIEN,0),U,15)
+10 if OLDCODE=""
QUIT
+11 SET NEWCODE=$$GETCW(OLDCODE)
+12 SET NEWCODEE=$$GET1^DIQ(9002313.25,NEWCODE,.01)
+13 SET DIE="^PSRX("_RXIEN_","_"""REJ"""_","
SET DA(1)=RXIEN
SET DA=REJIEN
SET DR="24///"_NEWCODEE
DO ^DIE
+14 SET ^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN)=OLDCODE_U_NEWCODE
End DoDot:2
End DoDot:1
+15 IF '$$GETSTOP()
Begin DoDot:1
+16 SET ^XTMP($$NAMSP,0,"STATUS")="Completed"_U_$$NOW^XLFDT
+17 DO NOTIFY
End DoDot:1
+18 QUIT
+19 ;
REJECT ;
+1 NEW ERR
+2 DO RESCH^XUTMOPT("PSO REJECTS BACKGROUND MESSAGE",$$FMADD^XLFDT($$NOW^XLFDT,1),"","24H","L",.ERR)
+3 QUIT
+4 ;
NOTIFY ; build mail message
+1 NEW XMSUB,XMDUZ,XMTEXT,XMY,I,RXIEN,REJIEN,RX,OLDVALUE,NEWVALUE,NEWDESC
+2 SET XMSUB="PSO*7*289 Clarification Code Conversion Results"
+3 SET XMDUZ="OUTPATIENT PHARMACY PACKAGE"
+4 SET XMTEXT="^TMP($J,""PSO7P289"",""NOTIFY"","
+5 SET XMY(^XTMP($$NAMSP,0,"JOBDUZ"))=""
+6 KILL ^TMP($JOB,"PSO7P289","NOTIFY")
+7 SET ^TMP($JOB,"PSO7P289","NOTIFY",1)="The Clarification Code Conversion queued install routine for patch"
+8 SET ^TMP($JOB,"PSO7P289","NOTIFY",2)="PSO*7*289 has completed. This message lists edited prescriptions."
+9 SET ^TMP($JOB,"PSO7P289","NOTIFY",3)=""
+10 SET ^TMP($JOB,"PSO7P289","NOTIFY",4)="The 'Old Value' column contains the internal set of codes value for"
+11 SET ^TMP($JOB,"PSO7P289","NOTIFY",5)="CLARIFICATION CODE field (#24) of REJECT INFO Multiple (#52.25) of"
+12 SET ^TMP($JOB,"PSO7P289","NOTIFY",6)="PRESCRIPTION file (#52). Possible old values consist of:"
+13 SET ^TMP($JOB,"PSO7P289","NOTIFY",7)=""
+14 SET ^TMP($JOB,"PSO7P289","NOTIFY",8)=$$RJ^XLFSTR("CODE",10)_" DESCRIPTION"
+15 SET ^TMP($JOB,"PSO7P289","NOTIFY",9)=$$RJ^XLFSTR("====",10)_" ======================="
+16 SET ^TMP($JOB,"PSO7P289","NOTIFY",10)=$$RJ^XLFSTR("0",10)_" FOR NOT SPECIFIED"
+17 SET ^TMP($JOB,"PSO7P289","NOTIFY",11)=$$RJ^XLFSTR("1",10)_" NO OVERRIDE"
+18 SET ^TMP($JOB,"PSO7P289","NOTIFY",12)=$$RJ^XLFSTR("2",10)_" OTHER OVERRIDE"
+19 SET ^TMP($JOB,"PSO7P289","NOTIFY",13)=$$RJ^XLFSTR("3",10)_" VACATION SUPPLY"
+20 SET ^TMP($JOB,"PSO7P289","NOTIFY",14)=$$RJ^XLFSTR("4",10)_" LOST PRESCRIPTION"
+21 SET ^TMP($JOB,"PSO7P289","NOTIFY",15)=$$RJ^XLFSTR("5",10)_" THERAPY CHANGE"
+22 SET ^TMP($JOB,"PSO7P289","NOTIFY",16)=$$RJ^XLFSTR("6",10)_" STARTER DOSE"
+23 SET ^TMP($JOB,"PSO7P289","NOTIFY",17)=$$RJ^XLFSTR("7",10)_" MEDICALY NECESSARY"
+24 SET ^TMP($JOB,"PSO7P289","NOTIFY",18)=$$RJ^XLFSTR("8",10)_" PROCESS COMPOUND"
+25 SET ^TMP($JOB,"PSO7P289","NOTIFY",19)=$$RJ^XLFSTR("9",10)_" ENCOUNTERS"
+26 SET ^TMP($JOB,"PSO7P289","NOTIFY",20)=""
+27 SET ^TMP($JOB,"PSO7P289","NOTIFY",21)="The 'New Value' column is the equivalent pointer to file 9002313.25."
+28 SET ^TMP($JOB,"PSO7P289","NOTIFY",22)="The 'New Value Description' describes the value."
+29 SET ^TMP($JOB,"PSO7P289","NOTIFY",23)=""
+30 SET ^TMP($JOB,"PSO7P289","NOTIFY",24)=$$RJ^XLFSTR("Reject",28)_$$RJ^XLFSTR("Old",7)_$$RJ^XLFSTR("New",7)
+31 SET ^TMP($JOB,"PSO7P289","NOTIFY",25)=$$RJ^XLFSTR("RXien",10)_$$RJ^XLFSTR("RX#",10)_$$RJ^XLFSTR("Ien",8)_$$RJ^XLFSTR("Value",7)_$$RJ^XLFSTR("Value",7)_" New Value Description"
+32 SET ^TMP($JOB,"PSO7P289","NOTIFY",26)="============================================================================="
+33 SET I=26
+34 SET RXIEN=0
+35 FOR
SET RXIEN=$ORDER(^XTMP($$NAMSP,0,"LOG",RXIEN))
if 'RXIEN
QUIT
Begin DoDot:1
+36 SET RX=$$GET1^DIQ(52,RXIEN,.01)
+37 SET REJIEN=0
+38 FOR
SET REJIEN=$ORDER(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN))
if 'REJIEN
QUIT
Begin DoDot:2
+39 SET I=I+1
+40 SET OLDVALUE=$PIECE(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",1)
+41 SET NEWVALUE=$PIECE(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",2)
+42 SET NEWDESC=$$GET1^DIQ(9002313.25,NEWVALUE,.02)
+43 SET ^TMP($JOB,"PSO7P289","NOTIFY",I)=$$RJ^XLFSTR(RXIEN,10)_$$RJ^XLFSTR(RX,10)_$$RJ^XLFSTR(REJIEN,8)_$$RJ^XLFSTR(OLDVALUE,7)_$$RJ^XLFSTR(NEWVALUE,7)_" "_NEWDESC
End DoDot:2
End DoDot:1
+44 DO ^XMD
+45 KILL ^TMP($JOB,"PSO7P289","NOTIFY")
+46 QUIT
+47 ;;
RESTORE ; restore old set of code values (backstop)
+1 NEW RXIEN,REJIEN,OLDVALUE,DIE,DA,DR
+2 SET RXIEN=0
+3 FOR
SET RXIEN=$ORDER(^XTMP($$NAMSP,0,"LOG",RXIEN))
if 'RXIEN
QUIT
Begin DoDot:1
+4 SET REJIEN=0
+5 FOR
SET REJIEN=$ORDER(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN))
if 'REJIEN
QUIT
Begin DoDot:2
+6 SET OLDVALUE=$PIECE(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",1)
+7 SET DIE="^PSRX("_RXIEN_","_"""REJ"""_","
SET DA(1)=RXIEN
SET DA=REJIEN
SET DR="24///"_OLDVALUE
DO ^DIE
End DoDot:2
End DoDot:1
+8 KILL ^XTMP($$NAMSP,0,"LOG")
+9 QUIT
+10 ;;
SETD0(VALUE) ;;
+1 SET ^XTMP($$NAMSP,0,"LASTD0")=VALUE
+2 QUIT
+3 ;
GETD0() ;;
+1 QUIT ^XTMP($$NAMSP,0,"LASTD0")
+2 ;
SETD1(VALUE) ;;
+1 SET ^XTMP($$NAMSP,0,"LASTD1")=VALUE
+2 QUIT
+3 ;
GETD1() ;
+1 QUIT ^XTMP($$NAMSP,0,"LASTD1")
+2 ;
SETCWS ;set cross-walk values
+1 ;;'0' FOR NOT SPECIFIED;
+2 ;;'1' FOR NO OVERRIDE;
+3 ;;'2' FOR OTHER OVERRIDE;
+4 ;;'3' FOR VACATION SUPPLY;
+5 ;;'4' FOR LOST PRESCRIPTION;
+6 ;;'5' FOR THERAPY CHANGE;
+7 ;;'6' FOR STARTER DOSE;
+8 ;;'7' FOR MEDICALLY NECESSARY;
+9 ;;'8' FOR PROCESS COMPOUND;
+10 ;;'9' FOR ENCOUNTERS;
+11 ;;'99' FOR OTHER;
+12 NEW I
+13 FOR I=0:1:9,99
DO SETCW(I)
+14 QUIT
+15 ;;
SETCW(VALUE) ;;
+1 NEW POINTER
+2 SET POINTER=$ORDER(^BPS(9002313.25,"B",VALUE,0))
+3 SET ^XTMP($$NAMSP,0,"CW",VALUE)=POINTER
+4 ;;
GETCW(VALUE) ;get cross-walk value
+1 IF $GET(VALUE)=""
QUIT ""
+2 QUIT $GET(^XTMP($$NAMSP,0,"CW",VALUE))
+3 ;;
SETSTOP(VALUE) ;;
+1 SET ^XTMP($$NAMSP,0,"STOP")=VALUE
+2 if +VALUE
SET ^XTMP($$NAMSP,0,"STATUS")="Stopped"_U_$$NOW^XLFDT
+3 QUIT
+4 ;;
GETSTOP() ;
+1 QUIT ^XTMP($$NAMSP,0,"STOP")
+2 ;;
DESP ;delete ePharmacy site parameter file if it exists
+1 ;; This utility is used a pre-install routine for PSO*7*289 patch to delete file 52.86 if it
+2 ;; exists so that the security parameters on the file may be updated to allow user read access.
+3 if '$DATA(^PS(52.86))
QUIT
+4 DO MES^XPDUTL(" ")
+5 DO MES^XPDUTL("Updating security parameters for ePharmacy Site Parameter file (#52.86).")
+6 DO MES^XPDUTL(" ")
+7 SET DIU="52.86"
SET DIU(0)="E"
DO EN^DIU2
KILL DIU
+8 DO MES^XPDUTL("Recreating the DATA DICTIONARY... File 52.86 update is complete.")
+9 QUIT
