Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSO7P289

PSO7P289.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Reference to 9002313.25 supported by DBIA 5064
  1.  ;
  1.  N NAMSP,PATCH,JOBN,JOBDUZ,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
  1.  S NAMSP=$$NAMSP
  1.  S JOBN="Clarification Code Conversion"
  1.  S JOBDUZ=$S($G(DUZ)'="":DUZ,1:.5)
  1.  S PATCH="PSO*7*289"
  1.  ;
  1.  L +^XTMP(NAMSP):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T D  Q
  1.  . D BMES^XPDUTL(JOBN_" job is already running.  Halting...")
  1.  . D MES^XPDUTL("")
  1.  . D QUIT
  1.  ;
  1.  I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,JOBN_", "_PATCH,90)        ;90 day life
  1.  S QUIT=0
  1.  ;
  1.  I $G(^XTMP(NAMSP,0,"STATUS"))["Completed" D  Q
  1.  . D BMES^XPDUTL("This conversion has been run before to completion on ")
  1.  . D MES^XPDUTL($$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"STATUS")),"^",2))_".")
  1.  . D MES^XPDUTL("If you want to run it again, do 'RESTORE^PSO7P289', then")
  1.  . D MES^XPDUTL("the global subscript ^XTMP('"_NAMSP_"') must be")
  1.  . D MES^XPDUTL("killed prior to doing so.")
  1.  . D MES^XPDUTL("")
  1.  . D MES^XPDUTL("It is strongly recommended you not do this.")
  1.  . D QUIT
  1.  ;
  1.  ;I '$D(XPDQUES("POS1")) D  I 'ZTDTH D QUIT Q
  1.  ;. K DIR
  1.  ;. S DIR("A")="Enter when to Queue the "_JOBN_" to run."
  1.  ;. S DIR("B")="NOW"
  1.  ;. S DIR(0)="D^::%DT"
  1.  ;. S DIR("?")="Enter when to start the job. This should be a time after the install has completed."
  1.  ;. D ^DIR
  1.  ;. I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S ZTDTH="" Q
  1.  ;. S ZTDTH=$$FMTH^XLFDT(Y)
  1.  ;
  1.  ;I $D(XPDQUES("POS1")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS1"))
  1.  S ZTDTH=$$FMTH^XLFDT($$NOW^XLFDT)
  1.  D BMES^XPDUTL("=============================================================")
  1.  D MES^XPDUTL("Queuing background job for "_JOBN_"...")
  1.  D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
  1.  D MES^XPDUTL("==============================================================")
  1.  I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
  1.  ;
  1.  S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
  1.  ;
  1.  I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
  1.  E  D
  1.  . S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
  1.  ;
  1.  S ZTRTN="EN^PSO7P289"
  1.  S ZTIO=""
  1.  S ZTDESC="Background job for "_JOBN_" on prescriptions updated via "_PATCH
  1.  S ZTSAVE("JOBN")=""
  1.  S ZTSAVE("JOBDUZ")=""
  1.  L -^XTMP(NAMSP)
  1.  D ^%ZTLOAD
  1.  D:$D(ZTSK)
  1.  . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
  1.  . D BMES^XPDUTL("")
  1.  D BMES^XPDUTL("")
  1.  Q
  1. QUIT ;
  1.  L -^XTMP(NAMSP)
  1.  ;
  1.  Q
  1.  ;
  1. STATUS ;show status of job running
  1.  I $$ST D
  1.  . W !,"Currently processing:"
  1.  . I $G(^XTMP($$NAMSP,0,"STATUS"))["Completed" D  Q
  1.  . . W !,"Completed on ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"STATUS")),"^",2)),!
  1.  . W !?5,"Rx being processed > ",$$GETD0
  1.  . W !?5,"  Reject being processed > ",$$GETD1
  1.  E  D
  1.  .I $G(^XTMP($$NAMSP,0,"STATUS"))["Completed" D
  1.  .. W !,"Completed on ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"STATUS")),"^",2)),!
  1.  Q
  1.  ;
  1. STOP ;stop job command
  1.  I $$ST D SETSTOP(1) D
  1.  . W !,"CLARIFICATION CODE CONVERSION Job - set to STOP Soon"
  1.  . W !!,"Check TASKMAN or Status to ensure it has stopped..."
  1.  . W !,"     (D STATUS^PSO7P289)"
  1.  Q
  1. ST() ;status
  1.  L +^XTMP($$NAMSP):3 I $T D  Q 0
  1.  . L -^XTMP($$NAMSP)
  1.  . W !,"*** NOT CURRENTLY RUNNING! ***",!
  1.  Q 1
  1.  ;
  1. INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
  1.  N BEGDT,PURGDT
  1.  S BEGDT=$$NOW^XLFDT()
  1.  S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
  1.  S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
  1.  Q
  1.  ;
  1. NAMSP() ;
  1.  Q $T(+0)
  1.  ;
  1. EN ;
  1.  D CONVERT
  1.  D REJECT
  1.  Q
  1.  ;
  1. CONVERT ;
  1.  Q:$P($G(^XTMP($$NAMSP,0,"STATUS")),U)="In Process"
  1.  Q:$P($G(^XTMP($$NAMSP,0,"STATUS")),U)="Completed"
  1.  D SETD0(0)
  1.  D SETD1(0)
  1.  D SETSTOP(0)
  1.  D SETCWS
  1.  S ^XTMP($$NAMSP,0,"STATUS")="In Process"_U_$$NOW^XLFDT
  1.  S ^XTMP($$NAMSP,0,"JOBDUZ")=$G(JOBDUZ)
  1.  S ^XTMP($$NAMSP,0,"JOBN")=$G(JOBN)
  1. RESUME ;
  1.  N RXIEN,REJIEN,OLDCODE,NEWCODE,NEWCODEE,DIE,DA,DR
  1.  S RXIEN=$$GETD0
  1.  F  S RXIEN=$O(^PSRX(RXIEN)) Q:'RXIEN!($$GETSTOP())  D
  1.  .D SETD0(RXIEN)
  1.  .D SETD1(0)
  1.  .S REJIEN=$$GETD1
  1.  .F  S REJIEN=$O(^PSRX(RXIEN,"REJ",REJIEN)) Q:'REJIEN  D
  1.  ..D SETD1(REJIEN)
  1.  ..S OLDCODE=$P(^PSRX(RXIEN,"REJ",REJIEN,0),U,15)
  1.  ..Q:OLDCODE=""
  1.  ..S NEWCODE=$$GETCW(OLDCODE)
  1.  ..S NEWCODEE=$$GET1^DIQ(9002313.25,NEWCODE,.01)
  1.  ..S DIE="^PSRX("_RXIEN_","_"""REJ"""_",",DA(1)=RXIEN,DA=REJIEN,DR="24///"_NEWCODEE D ^DIE
  1.  ..S ^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN)=OLDCODE_U_NEWCODE
  1.  I '$$GETSTOP() D
  1.  .S ^XTMP($$NAMSP,0,"STATUS")="Completed"_U_$$NOW^XLFDT
  1.  .D NOTIFY
  1.  Q
  1.  ;
  1. REJECT ;
  1.  N ERR
  1.  D RESCH^XUTMOPT("PSO REJECTS BACKGROUND MESSAGE",$$FMADD^XLFDT($$NOW^XLFDT,1),"","24H","L",.ERR)
  1.  Q
  1.  ;
  1. NOTIFY ; build mail message
  1.  N XMSUB,XMDUZ,XMTEXT,XMY,I,RXIEN,REJIEN,RX,OLDVALUE,NEWVALUE,NEWDESC
  1.  S XMSUB="PSO*7*289 Clarification Code Conversion Results"
  1.  S XMDUZ="OUTPATIENT PHARMACY PACKAGE"
  1.  S XMTEXT="^TMP($J,""PSO7P289"",""NOTIFY"","
  1.  S XMY(^XTMP($$NAMSP,0,"JOBDUZ"))=""
  1.  K ^TMP($J,"PSO7P289","NOTIFY")
  1.  S ^TMP($J,"PSO7P289","NOTIFY",1)="The Clarification Code Conversion queued install routine for patch"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",2)="PSO*7*289 has completed.  This message lists edited prescriptions."
  1.  S ^TMP($J,"PSO7P289","NOTIFY",3)=""
  1.  S ^TMP($J,"PSO7P289","NOTIFY",4)="The 'Old Value' column contains the internal set of codes value for"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",5)="CLARIFICATION CODE field (#24) of REJECT INFO Multiple (#52.25) of"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",6)="PRESCRIPTION file (#52). Possible old values consist of:"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",7)=""
  1.  S ^TMP($J,"PSO7P289","NOTIFY",8)=$$RJ^XLFSTR("CODE",10)_"   DESCRIPTION"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",9)=$$RJ^XLFSTR("====",10)_"   ======================="
  1.  S ^TMP($J,"PSO7P289","NOTIFY",10)=$$RJ^XLFSTR("0",10)_"   FOR NOT SPECIFIED"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",11)=$$RJ^XLFSTR("1",10)_"   NO OVERRIDE"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",12)=$$RJ^XLFSTR("2",10)_"   OTHER OVERRIDE"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",13)=$$RJ^XLFSTR("3",10)_"   VACATION SUPPLY"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",14)=$$RJ^XLFSTR("4",10)_"   LOST PRESCRIPTION"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",15)=$$RJ^XLFSTR("5",10)_"   THERAPY CHANGE"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",16)=$$RJ^XLFSTR("6",10)_"   STARTER DOSE"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",17)=$$RJ^XLFSTR("7",10)_"   MEDICALY NECESSARY"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",18)=$$RJ^XLFSTR("8",10)_"   PROCESS COMPOUND"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",19)=$$RJ^XLFSTR("9",10)_"   ENCOUNTERS"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",20)=""
  1.  S ^TMP($J,"PSO7P289","NOTIFY",21)="The 'New Value' column is the equivalent pointer to file 9002313.25."
  1.  S ^TMP($J,"PSO7P289","NOTIFY",22)="The 'New Value Description' describes the value."
  1.  S ^TMP($J,"PSO7P289","NOTIFY",23)=""
  1.  S ^TMP($J,"PSO7P289","NOTIFY",24)=$$RJ^XLFSTR("Reject",28)_$$RJ^XLFSTR("Old",7)_$$RJ^XLFSTR("New",7)
  1.  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"
  1.  S ^TMP($J,"PSO7P289","NOTIFY",26)="============================================================================="
  1.  S I=26
  1.  S RXIEN=0
  1.  F  S RXIEN=$O(^XTMP($$NAMSP,0,"LOG",RXIEN)) Q:'RXIEN  D
  1.  .S RX=$$GET1^DIQ(52,RXIEN,.01)
  1.  .S REJIEN=0
  1.  .F  S REJIEN=$O(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN)) Q:'REJIEN  D
  1.  ..S I=I+1
  1.  ..S OLDVALUE=$P(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",1)
  1.  ..S NEWVALUE=$P(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",2)
  1.  ..S NEWDESC=$$GET1^DIQ(9002313.25,NEWVALUE,.02)
  1.  ..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
  1.  D ^XMD
  1.  K ^TMP($J,"PSO7P289","NOTIFY")
  1.  Q
  1.  ;;
  1. RESTORE ; restore old set of code values (backstop)
  1.  N RXIEN,REJIEN,OLDVALUE,DIE,DA,DR
  1.  S RXIEN=0
  1.  F  S RXIEN=$O(^XTMP($$NAMSP,0,"LOG",RXIEN)) Q:'RXIEN  D
  1.  .S REJIEN=0
  1.  .F  S REJIEN=$O(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN)) Q:'REJIEN  D
  1.  ..S OLDVALUE=$P(^XTMP($$NAMSP,0,"LOG",RXIEN,REJIEN),"^",1)
  1.  ..S DIE="^PSRX("_RXIEN_","_"""REJ"""_",",DA(1)=RXIEN,DA=REJIEN,DR="24///"_OLDVALUE D ^DIE
  1.  K ^XTMP($$NAMSP,0,"LOG")
  1.  Q
  1.  ;;
  1. SETD0(VALUE) ;;
  1.  S ^XTMP($$NAMSP,0,"LASTD0")=VALUE
  1.  Q
  1.  ;
  1. GETD0() ;;
  1.  Q ^XTMP($$NAMSP,0,"LASTD0")
  1.  ;
  1. SETD1(VALUE) ;;
  1.  S ^XTMP($$NAMSP,0,"LASTD1")=VALUE
  1.  Q
  1.  ;
  1. GETD1() ;
  1.  Q ^XTMP($$NAMSP,0,"LASTD1")
  1.  ;
  1. SETCWS ;set cross-walk values
  1.  ;;'0' FOR NOT SPECIFIED; 
  1.     ;;'1' FOR NO OVERRIDE; 
  1.     ;;'2' FOR OTHER OVERRIDE; 
  1.     ;;'3' FOR VACATION SUPPLY; 
  1.     ;;'4' FOR LOST PRESCRIPTION; 
  1.     ;;'5' FOR THERAPY CHANGE; 
  1.     ;;'6' FOR STARTER DOSE; 
  1.     ;;'7' FOR MEDICALLY NECESSARY; 
  1.     ;;'8' FOR PROCESS COMPOUND; 
  1.     ;;'9' FOR ENCOUNTERS; 
  1.     ;;'99' FOR OTHER;
  1.     N I
  1.     F I=0:1:9,99 D SETCW(I)
  1.     Q 
  1.  ;;
  1. SETCW(VALUE) ;;
  1.  N POINTER
  1.  S POINTER=$O(^BPS(9002313.25,"B",VALUE,0))
  1.  S ^XTMP($$NAMSP,0,"CW",VALUE)=POINTER
  1.  ;;
  1. GETCW(VALUE) ;get cross-walk value
  1.  I $G(VALUE)="" Q ""
  1.  Q $G(^XTMP($$NAMSP,0,"CW",VALUE))
  1.  ;;
  1. SETSTOP(VALUE) ;;
  1.  S ^XTMP($$NAMSP,0,"STOP")=VALUE
  1.  S:+VALUE ^XTMP($$NAMSP,0,"STATUS")="Stopped"_U_$$NOW^XLFDT
  1.  Q
  1.  ;;
  1. GETSTOP() ;
  1.  Q ^XTMP($$NAMSP,0,"STOP")
  1.  ;;
  1. 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
  1.  ;; exists so that the security parameters on the file may be updated to allow user read access.
  1.  Q:'$D(^PS(52.86))
  1.  D MES^XPDUTL(" ")
  1.  D MES^XPDUTL("Updating security parameters for ePharmacy Site Parameter file (#52.86).")
  1.  D MES^XPDUTL(" ")
  1.  S DIU="52.86",DIU(0)="E" D EN^DIU2 K DIU
  1.  D MES^XPDUTL("Recreating the DATA DICTIONARY...   File 52.86 update is complete.")
  1.  Q