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

PSOCIDC9.m

Go to the documentation of this file. 
  1. PSOCIDC9 ;BIR/LE - continuation of activity log corrections ;2/28/05 12:50pm
  1.  ;;7.0;OUTPATIENT PHARMACY;**239,250**;DEC 1997
  1.  ;
  1. RPT ;
  1.  N JOBN,NAMSP,ZTDESC,ZTRTN,ZTQUEUED,ZTREQ
  1.  S NAMSP=$$NAMSP^PSOCIDC7
  1.  S JOBN="CIDC ACTIVITY LOG CORRECTION"
  1.  L +^XTMP(NAMSP):0 I '$T D  Q
  1.  .W !,JOBN_" job for PSO*7*239 is still running.  Halting..."
  1.  L -^XTMP(NAMSP)
  1.  W !!,"This report reflects all prescriptions where the activity and"
  1.  W !,"copay activity logs were corrected.  For detailed information,"
  1.  W !,"please view the activity and copay logs on the prescriptions."
  1.  ;
  1.  W !!,"You may queue the report to print, if you wish.",!
  1.  ;
  1. DVC ;
  1.  K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
  1. QUEUE ;
  1.  I $D(IO("Q")) S ZTRTN="START^PSOCIDC9",ZTDESC=JOBN_" CIDC Activity Logs Corrections" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
  1. START ;
  1.  U IO
  1.  N BLDT,RXO,NAMSP,PSOFILL,PSODFN,PSONAM,PSOOUT,PSODV,RXP,SSN,PSODIV,PSODV
  1.  N CANCEL,JOBN,PSOPATID,PSOTOT
  1.  S NAMSP=$$NAMSP^PSOCIDC7
  1.  ;****************************************************** for testing only - next line
  1.  S JOBN="CIDC ACTIVITY LOGS CORRECTION"
  1.  S PSOOUT=0,PSODV=$S($E(IOST)="C":"C",1:"P")
  1.  S PSOPGCT=0,PSOPGLN=IOSL-7,PSOPGCT=1
  1.  S BLDT=$P($G(^XTMP(NAMSP,0,"LAST")),"^",2)
  1.  I '$D(DT) S DT=$$NOW^XLFDT
  1.  D TITLE
  1.  S (PSOTOT,PSONAM)=""
  1.  F  S PSONAM=$O(^XTMP(NAMSP,"LOG",PSONAM)) Q:PSONAM=""  D
  1.  .S PSODFN=""
  1.  .F  S PSODFN=$O(^XTMP(NAMSP,"LOG",PSONAM,PSODFN)) Q:PSODFN=""  D
  1.  ..S RXP=""
  1.  ..F  S RXP=$O(^XTMP(NAMSP,"LOG",PSONAM,PSODFN,RXP)) Q:RXP=""  D
  1.  ...D FULL Q:$G(PSOOUT)  S PSONAME=$P($G(^DPT(PSODFN,0)),"^"),PSOTOT=PSOTOT+1
  1.  ...W !,$E(PSONAME,1,14)
  1.  ...D PRTSSN
  1.  ...S RXO=$P($G(^PSRX(RXP,0)),"^")
  1.  ...W ?41," ",RXO  ;," (",PSOFILL,")"
  1.  W:PSOTOT'="" !,"Total number of prescriptions modified: ",PSOTOT
  1.  G END
  1.  ;
  1. FULL ;
  1.  I ($Y+7)>IOSL&('$G(PSOOUT)) D TITLE
  1.  Q
  1.  ;
  1. TITLE ;
  1.  I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
  1.  ;
  1.  W @IOF D
  1.  . W !,"Patch PSO*7*239 - Corrected Activity and Copay Activity logs",!!
  1.  . W "Note that this report reflects all prescriptions where the activity and/or",!
  1.  . W "copay activity logs were corrected. For detailed information, please view",!
  1.  . W "the activity and copay activity log on the prescription.",!
  1.  ;
  1.  S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
  1.  F MJT=1:1:79 W "="
  1.  ;W !?55,"Updated",?67,"Updated"
  1.  ;W !,?55,"Activity",?67,"COPAY"
  1.  W !,"PATIENT NAME     (SSN)       DIV",?42,"RX# " ;,?55,"Log",?67,"Activity Log"   ;,?55,"RELEASE DATE",?69,"REL   BILL"
  1.  W !,"---------------  -------  --------------",?42,"------------"
  1.  ;W ?55,"------------",?67,"-----------"
  1.  S PSOPGCT=PSOPGCT+1
  1.  Q
  1.  ;
  1. END ;
  1.  I '$G(PSOOUT),$G(PSODV)="C" W !!,"** End of Report **" K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1.  I $G(PSODV)="C" W !
  1.  E  W @IOF
  1. DONE ;
  1.  K MJT,PSOPGCT,PSOPGLN,Y,DIR,X,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT
  1.  D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. PRTSSN ;
  1.  S SSN=$P(^DPT(PSODFN,0),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN))
  1.  S PSOPATID=$E(PSONAM,1)_SSN
  1.  S PSODIV=$P($G(^PSRX(RXP,2)),"^",9)
  1.  S:PSODIV'="" PSODIV=$P($G(^PS(59,PSODIV,0)),"^",1)
  1.  W ?17,"("_PSOPATID_")"_"  "_$E(PSODIV,1,15)
  1.  Q
  1.  ;------
  1. LOCKED ;LIST OF LOCKED RX'S
  1.  N JOBN,NAMSP,ZTDESC,ZTRTN,ZTQUEUED,ZTREQ,PSODV
  1.  S NAMSP=$$NAMSP^PSOCIDC7
  1.  S JOBN="CIDC ACTIVITY LOG CORRECTION - LOCKED PRESCRIPTIONS"
  1.  L +^XTMP(NAMSP):0 I '$T D  Q
  1.  .W !,JOBN_" job for PSO*7*239 is still running.  Halting..."
  1.  L -^XTMP(NAMSP)
  1.  W !!,"This report reflects all prescriptions where the activity and",!
  1.  W "copay activity logs could not be corrected due to the Rx being locked."
  1.  ;
  1.  W !!,"You may queue the report to print, if you wish.",!
  1.  ;
  1. DVC2 ;
  1.  K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
  1. QUEUE2 ;
  1.  I $D(IO("Q")) S ZTRTN="START2^PSOCIDC9",ZTDESC=JOBN_" CIDC Activity Logs Corrections - Locked Rx's" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
  1. START2 ;
  1.  U IO
  1.  N BLDT,NAMSP,PSODFN,PSONAM,PSONAME,PSOOUT,PSODV,RXP,SSN,PSODIV,PSOPGCT,PSOOUT
  1.  N CANCEL,JOBN,PSOPATID,PSOTOT,PSONCNT,PSORXN
  1.  S NAMSP=$$NAMSP^PSOCIDC7
  1.  S JOBN="CIDC ACTIVITY LOGS CORRECTION - Locked Rx report"
  1.  S (PSOPGCT,PSONCNT,PSOOUT)=0,PSODV=$S($E(IOST)="C":"C",1:"P")
  1.  S PSOPGLN=IOSL-7,PSOPGCT=1,RXP=""
  1.  S BLDT=$P($G(^XTMP(NAMSP,0,"LAST")),"^",2)
  1.  I '$D(DT) S DT=$$NOW^XLFDT
  1.  D TITLE2
  1.  F  S RXP=$O(^XTMP(NAMSP,0,"LOCKED RX",RXP)) Q:RXP=""  D
  1.  . D FULL2 Q:$G(PSOOUT)
  1.  . S PSONCNT=PSONCNT+1
  1.  . S (DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2),PSORXN=$P($G(^PSRX(RXP,0)),"^")
  1.  . S (PSONAME,PSONAM)=$P($G(^DPT(PSODFN,0)),"^") W !,$E(PSONAME,1,14)
  1.  . D PRTSSN
  1.  . W ?41," ",PSORXN
  1.  . W:^XTMP(NAMSP,0,"LOCKED RX",RXP)'="" ?60,"CORRECTED"
  1.  W !!,"Total number of prescriptions locked: ",PSONCNT,!
  1.  G END
  1.  Q
  1.  ;
  1. FULL2 ;
  1.  I ($Y+7)>IOSL&('$G(PSOOUT)) D TITLE2
  1.  Q
  1.  ;
  1. TITLE2 ;
  1.  I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
  1.  ;
  1.  W @IOF D
  1.  . W !,"Patch PSO*7*239 - Locked Prescription Number Report",!!
  1.  . W "Note that this report reflects all prescriptions where the activity and/or",!
  1.  . W "copay activity logs could not be corrected. For detailed information,",!
  1.  . W "please view the activity and copay activity log on the prescription.",!
  1.  . W !!,"Note that FIXONE^PSOCIDC9 can be run from programmer's mode"
  1.  . W !,"to correct individual prescriptions.",!!
  1.  ;
  1.  S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
  1.  F MJT=1:1:79 W "="
  1.  ;
  1.  W !,"PATIENT NAME     (SSN)       DIV",?42,"RX# "
  1.  W !,"---------------  -------  --------------",?42,"------------"
  1.  S PSOPGCT=PSOPGCT+1
  1.  Q
  1.  ;
  1. FIXONE ;FIX LOCKED RX'S
  1.  N RXP,SEQ,CSEQ,PSOMSG,PSONTIM,PSOCHECK,FIXONE,PSOFONE,NAMSP
  1.  W @IOF D
  1.  . W !,"This function is used to correct individual prescriptions that were locked"
  1.  . W !,"during the CIDC Activity Log clean-up process.  It verifies whether the"
  1.  . W !,"prescription needs to be corrected, and if so corrects it.  If the Rx still"
  1.  . W !,"cannot be locked for correction, a message stating such will be displayed."
  1.  . W !,"Otherwise, a message stating that no correction is needed will be displayed.",!
  1.  . W !,"For detailed information please view the activity and copay activity log on"
  1.  . W !,"the prescription.  For a listing of locked Rx's, type D LOCKED^PSOCIDC9 at"
  1.  . W !,"the programmer's prompt.",!
  1.  ;
  1. FIX2 ;
  1.  S (PSOMSG,PSONTIM,FIXONE,PSOFONE)=""
  1.  K DIC
  1.  W ! S DIC="^PSRX(",DIC(0)="QEA" D ^DIC Q:Y<0
  1.  S RXP=+Y,(DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2),PSONAM=$P($G(^DPT(PSODFN,0)),"^")
  1.  W !,"For Patient: ",PSONAM
  1.  S (PSOCHECK,SEQ,CSEQ)=0,NAMSP=$$NAMSP^PSOCIDC7
  1.  I $D(^PSRX(RXP,"A",0)) F  S SEQ=$O(^PSRX(RXP,"A",SEQ)) Q:SEQ=""  I $G(^PSRX(RXP,"A",SEQ,0))["BKGD CIDC" S PSOCHECK=1
  1.  I $D(^PSRX(RXP,"COPAY",0)) F  S CSEQ=$O(^PSRX(RXP,"COPAY",CSEQ)) Q:CSEQ=""  I $G(^PSRX(RXP,"COPAY",CSEQ,0))["BKGD CIDC" S PSOCHECK=1
  1.  I 'PSOCHECK W !!,"No changes are needed for this prescription.",! G FIX2
  1.  S FIXONE=1 D CHECK^PSOCIDC8
  1.  I '$G(PSOFONE) W !,"Activity logs corrected.",!! S ^XTMP("PSOCIDC7",0,"LOCKED RX",RXP)=DUZ_"^"_$H
  1.  G FIX2
  1.  Q