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

PSO160DR.m

Go to the documentation of this file. 
  1. PSO160DR ;BIR/BHW-Patch 160 Post Install routine - Driver ;11/24/03
  1.  ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
  1.  ;External reference to ^SC( supported by DBIA 2675
  1.  ;External reference to ^ORD(101, is supp. by DBIA# 872
  1.  ;
  1.  ;Setup TaskManager Task
  1.  D MGCHK,PRTCL S ZTDTH=@XPDGREF@("PSO160Q"),ZTIO=""
  1.  S ZTRTN="START^PSO160DR",ZTDESC="Post Install for patch PSO*7*160"
  1.  D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
  1.  I $D(ZTSK)&('$D(ZTQUEUED)) D BMES^XPDUTL("Task Queued!")
  1.  Q
  1.  ;
  1. START ;
  1.  N PSOTDFN,PSOTDBG,PSOTIBD,TPBCL,PATNAM,PATSSN,VADM,DFN,HLIEN,HLSTOP,SP
  1.  N PSOTCNT,PATCNT,RXCNT,EMCNT,HLSTOPC,HLCNT,PATSTATC,PATSTAT,X1,X2,X,%
  1.  N TPBCLP,TPBCLE
  1.  ;
  1.  K ^XTMP("PSO160P1",$J),^XTMP("PSO160P2",$J)
  1.  L +^XTMP("PSO160DR"):0 I '$T W "Already running." S:$D(ZTQUEUED) ZTREQ="@" Q
  1.  D NOW^%DTC S ^XTMP("PSO160DR",$J,"START")=%
  1.  I '$G(DT) S DT=$$DT^XLFDT
  1.  S $P(SP," ",80)="",X1=DT,X2=+90 D C^%DTC
  1.  S (^XTMP("PSO160P1",0),^XTMP("PSO160P2",0))=$G(X)_"^"_DT
  1.  ;
  1.  ;Begin Processing.  Entry point for Task
  1.  S (PSOTDFN,PATCNT,RXCNT)=0,EMCNT=1
  1.  ;
  1.  ;Find NON-VA entry in RX PATIENT STATUS file (#53)
  1.  S (PATSTATC,PATSTAT)=0
  1.  F  S PATSTAT=$O(^PS(53,"B",PATSTAT)) Q:'$L(PATSTAT)  D
  1.  . I $$UP^XLFSTR(PATSTAT)="NON-VA" D
  1.  . . S PATSTATC=$O(^PS(53,"B",PATSTAT,""))
  1.  . . Q
  1.  . Q
  1.  I 'PATSTATC S PATSTATC=""
  1.  ;
  1.  ;Find TPB Clinic (Used in TPB Eligibility Loop)
  1.  S (HLIEN,HLCNT)=0,(HLSTOP,HLSTOPC,TPBCL,TPBCLE)=""
  1.  F  S HLIEN=$O(^SC(HLIEN)) Q:'HLIEN  D
  1.  . S HLSTOP=$$GET1^DIQ(44,HLIEN,8,"I") Q:'HLSTOP
  1.  . S HLSTOPC=$$GET1^DIQ(40.7,HLSTOP,1) Q:'HLSTOPC
  1.  . I (HLSTOPC=161) D
  1.  . . S HLCNT=HLCNT+1,TPBCL=HLSTOP,TPBCLE=$$GET1^DIQ(40.7,HLSTOP,.01)
  1.  . . Q
  1.  . Q
  1.  ;If more than 1 CLINIC found, set to 0 because we can't set it
  1.  I (HLCNT>1) S TPBCL=0,TPBCLE=""
  1.  ;
  1.  ;Start Loop of TPB ELIGIBILITY (#52.91)
  1.  ;
  1.  S PSOTDFN=0
  1.  F  S PSOTDFN=$O(^PS(52.91,PSOTDFN)) Q:'PSOTDFN  D
  1.  . ;
  1.  . S PSOTDBG=$$GET1^DIQ(52.91,PSOTDFN,1,"I")     ;Get DATE PHARMACY BENEFIT BEGAN
  1.  . S PSOTIBD=$$GET1^DIQ(52.91,PSOTDFN,2,"I")     ;Get INACTIVATION OF BENEFIT DATE
  1.  . ;
  1.  . ;Get PATIENT (#2) Specific Information
  1.  . S DFN=PSOTDFN D DEM^VADPT
  1.  . S PATNAM=$P(VADM(1),U,1)
  1.  . I '$L(PATNAM) S PATNAM="Missing Patient"
  1.  . S PATSSN=$P(VADM(2),U,2)
  1.  . S PATSSN=$E($P(PATSSN,"-",3),1,5)
  1.  . ;
  1.  . ;Marking Rx's as TPB - Part 1
  1.  . D EN^PSO160P1
  1.  . ;
  1.  . ;Inactivating Patient TPB's Benefit - Part 2
  1.  . D EN^PSO160P2
  1.  . Q
  1.  ;
  1.  ;Process FINISH date (to be included in the Mailman messages)
  1.  D NOW^%DTC S ^XTMP("PSO160DR",$J,"FINISH")=%
  1.  ;
  1.  ;Mailman Message with Rx's marked as TPB - Part 1
  1.  D MAIL^PSO160P1
  1.  ;
  1.  ;Mailman Message with Patients inactivated from TPB - Part 2
  1.  D MAIL^PSO160P2
  1.  ;
  1.  L -^XTMP("PSO160DR") K ^XTMP("PSO160DR",$J)
  1.  Q
  1.  ;
  1. PRTCL ;Adds the Pharmacy PSO TPB SD SUB protocol as a subscriber to the
  1.  ;Scheduling protocol SDAM APPOINTMENT EVENTS
  1.  ;
  1.  N SDPRTCL,PSOPRTCL,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
  1.  ;
  1.  S SDPRTCL=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",""))
  1.  S PSOPRTCL=$O(^ORD(101,"B","PSO TPB SD SUB",""))
  1.  ;
  1.  I 'SDPRTCL!'PSOPRTCL Q
  1.  ;
  1.  ;Already a subscriber
  1.  I $D(^ORD(101,SDPRTCL,10,"B",PSOPRTCL)) Q
  1.  ;
  1.  S X=PSOPRTCL,DIC="^ORD(101,"_SDPRTCL_",10,",DLAYGO=101.01
  1.  S DA(1)=SDPRTCL,DIC(0)="L" D FILE^DICN
  1.  Q
  1.  ;
  1.  ;
  1. MGCHK ;If ther user installing the patch is not on the new Mail Group 
  1.  ;PSO TPB GROUP, include him/her as a member
  1.  ;
  1.  N MGIEN,USER,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
  1.  S USER=+@XPDGREF@("PSOUSER"),MGIEN=$O(^XMB(3.8,"B","PSO TPB GROUP",""))
  1.  I 'MGIEN Q
  1.  I $D(^XMB(3.8,MGIEN,1,"B",USER)) Q
  1.  S X=USER,DIC="^XMB(3.8,"_MGIEN_",1,",DLAYGO=3.81
  1.  S DA(1)=MGIEN,DIC(0)="L" D FILE^DICN
  1.  Q