PSO160DR ;BIR/BHW-Patch 160 Post Install routine - Driver ;11/24/03
;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
;External reference to ^SC( supported by DBIA 2675
;External reference to ^ORD(101, is supp. by DBIA# 872
;
;Setup TaskManager Task
D MGCHK,PRTCL S ZTDTH=@XPDGREF@("PSO160Q"),ZTIO=""
S ZTRTN="START^PSO160DR",ZTDESC="Post Install for patch PSO*7*160"
D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
I $D(ZTSK)&('$D(ZTQUEUED)) D BMES^XPDUTL("Task Queued!")
Q
;
START ;
N PSOTDFN,PSOTDBG,PSOTIBD,TPBCL,PATNAM,PATSSN,VADM,DFN,HLIEN,HLSTOP,SP
N PSOTCNT,PATCNT,RXCNT,EMCNT,HLSTOPC,HLCNT,PATSTATC,PATSTAT,X1,X2,X,%
N TPBCLP,TPBCLE
;
K ^XTMP("PSO160P1",$J),^XTMP("PSO160P2",$J)
L +^XTMP("PSO160DR"):0 I '$T W "Already running." S:$D(ZTQUEUED) ZTREQ="@" Q
D NOW^%DTC S ^XTMP("PSO160DR",$J,"START")=%
I '$G(DT) S DT=$$DT^XLFDT
S $P(SP," ",80)="",X1=DT,X2=+90 D C^%DTC
S (^XTMP("PSO160P1",0),^XTMP("PSO160P2",0))=$G(X)_"^"_DT
;
;Begin Processing. Entry point for Task
S (PSOTDFN,PATCNT,RXCNT)=0,EMCNT=1
;
;Find NON-VA entry in RX PATIENT STATUS file (#53)
S (PATSTATC,PATSTAT)=0
F S PATSTAT=$O(^PS(53,"B",PATSTAT)) Q:'$L(PATSTAT) D
. I $$UP^XLFSTR(PATSTAT)="NON-VA" D
. . S PATSTATC=$O(^PS(53,"B",PATSTAT,""))
. . Q
. Q
I 'PATSTATC S PATSTATC=""
;
;Find TPB Clinic (Used in TPB Eligibility Loop)
S (HLIEN,HLCNT)=0,(HLSTOP,HLSTOPC,TPBCL,TPBCLE)=""
F S HLIEN=$O(^SC(HLIEN)) Q:'HLIEN D
. S HLSTOP=$$GET1^DIQ(44,HLIEN,8,"I") Q:'HLSTOP
. S HLSTOPC=$$GET1^DIQ(40.7,HLSTOP,1) Q:'HLSTOPC
. I (HLSTOPC=161) D
. . S HLCNT=HLCNT+1,TPBCL=HLSTOP,TPBCLE=$$GET1^DIQ(40.7,HLSTOP,.01)
. . Q
. Q
;If more than 1 CLINIC found, set to 0 because we can't set it
I (HLCNT>1) S TPBCL=0,TPBCLE=""
;
;Start Loop of TPB ELIGIBILITY (#52.91)
;
S PSOTDFN=0
F S PSOTDFN=$O(^PS(52.91,PSOTDFN)) Q:'PSOTDFN D
. ;
. S PSOTDBG=$$GET1^DIQ(52.91,PSOTDFN,1,"I") ;Get DATE PHARMACY BENEFIT BEGAN
. S PSOTIBD=$$GET1^DIQ(52.91,PSOTDFN,2,"I") ;Get INACTIVATION OF BENEFIT DATE
. ;
. ;Get PATIENT (#2) Specific Information
. S DFN=PSOTDFN D DEM^VADPT
. S PATNAM=$P(VADM(1),U,1)
. I '$L(PATNAM) S PATNAM="Missing Patient"
. S PATSSN=$P(VADM(2),U,2)
. S PATSSN=$E($P(PATSSN,"-",3),1,5)
. ;
. ;Marking Rx's as TPB - Part 1
. D EN^PSO160P1
. ;
. ;Inactivating Patient TPB's Benefit - Part 2
. D EN^PSO160P2
. Q
;
;Process FINISH date (to be included in the Mailman messages)
D NOW^%DTC S ^XTMP("PSO160DR",$J,"FINISH")=%
;
;Mailman Message with Rx's marked as TPB - Part 1
D MAIL^PSO160P1
;
;Mailman Message with Patients inactivated from TPB - Part 2
D MAIL^PSO160P2
;
L -^XTMP("PSO160DR") K ^XTMP("PSO160DR",$J)
Q
;
PRTCL ;Adds the Pharmacy PSO TPB SD SUB protocol as a subscriber to the
;Scheduling protocol SDAM APPOINTMENT EVENTS
;
N SDPRTCL,PSOPRTCL,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
;
S SDPRTCL=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",""))
S PSOPRTCL=$O(^ORD(101,"B","PSO TPB SD SUB",""))
;
I 'SDPRTCL!'PSOPRTCL Q
;
;Already a subscriber
I $D(^ORD(101,SDPRTCL,10,"B",PSOPRTCL)) Q
;
S X=PSOPRTCL,DIC="^ORD(101,"_SDPRTCL_",10,",DLAYGO=101.01
S DA(1)=SDPRTCL,DIC(0)="L" D FILE^DICN
Q
;
;
MGCHK ;If ther user installing the patch is not on the new Mail Group
;PSO TPB GROUP, include him/her as a member
;
N MGIEN,USER,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
S USER=+@XPDGREF@("PSOUSER"),MGIEN=$O(^XMB(3.8,"B","PSO TPB GROUP",""))
I 'MGIEN Q
I $D(^XMB(3.8,MGIEN,1,"B",USER)) Q
S X=USER,DIC="^XMB(3.8,"_MGIEN_",1,",DLAYGO=3.81
S DA(1)=MGIEN,DIC(0)="L" D FILE^DICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO160DR 3629 printed Dec 13, 2024@02:22:38 Page 2
PSO160DR ;BIR/BHW-Patch 160 Post Install routine - Driver ;11/24/03
+1 ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
+2 ;External reference to ^SC( supported by DBIA 2675
+3 ;External reference to ^ORD(101, is supp. by DBIA# 872
+4 ;
+5 ;Setup TaskManager Task
+6 DO MGCHK
DO PRTCL
SET ZTDTH=@XPDGREF@("PSO160Q")
SET ZTIO=""
+7 SET ZTRTN="START^PSO160DR"
SET ZTDESC="Post Install for patch PSO*7*160"
+8 DO ^%ZTLOAD
KILL ZTDTH,ZTRTN,ZTIO,ZTDESC
+9 IF $DATA(ZTSK)&('$DATA(ZTQUEUED))
DO BMES^XPDUTL("Task Queued!")
+10 QUIT
+11 ;
START ;
+1 NEW PSOTDFN,PSOTDBG,PSOTIBD,TPBCL,PATNAM,PATSSN,VADM,DFN,HLIEN,HLSTOP,SP
+2 NEW PSOTCNT,PATCNT,RXCNT,EMCNT,HLSTOPC,HLCNT,PATSTATC,PATSTAT,X1,X2,X,%
+3 NEW TPBCLP,TPBCLE
+4 ;
+5 KILL ^XTMP("PSO160P1",$JOB),^XTMP("PSO160P2",$JOB)
+6 LOCK +^XTMP("PSO160DR"):0
IF '$TEST
WRITE "Already running."
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+7 DO NOW^%DTC
SET ^XTMP("PSO160DR",$JOB,"START")=%
+8 IF '$GET(DT)
SET DT=$$DT^XLFDT
+9 SET $PIECE(SP," ",80)=""
SET X1=DT
SET X2=+90
DO C^%DTC
+10 SET (^XTMP("PSO160P1",0),^XTMP("PSO160P2",0))=$GET(X)_"^"_DT
+11 ;
+12 ;Begin Processing. Entry point for Task
+13 SET (PSOTDFN,PATCNT,RXCNT)=0
SET EMCNT=1
+14 ;
+15 ;Find NON-VA entry in RX PATIENT STATUS file (#53)
+16 SET (PATSTATC,PATSTAT)=0
+17 FOR
SET PATSTAT=$ORDER(^PS(53,"B",PATSTAT))
if '$LENGTH(PATSTAT)
QUIT
Begin DoDot:1
+18 IF $$UP^XLFSTR(PATSTAT)="NON-VA"
Begin DoDot:2
+19 SET PATSTATC=$ORDER(^PS(53,"B",PATSTAT,""))
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF 'PATSTATC
SET PATSTATC=""
+23 ;
+24 ;Find TPB Clinic (Used in TPB Eligibility Loop)
+25 SET (HLIEN,HLCNT)=0
SET (HLSTOP,HLSTOPC,TPBCL,TPBCLE)=""
+26 FOR
SET HLIEN=$ORDER(^SC(HLIEN))
if 'HLIEN
QUIT
Begin DoDot:1
+27 SET HLSTOP=$$GET1^DIQ(44,HLIEN,8,"I")
if 'HLSTOP
QUIT
+28 SET HLSTOPC=$$GET1^DIQ(40.7,HLSTOP,1)
if 'HLSTOPC
QUIT
+29 IF (HLSTOPC=161)
Begin DoDot:2
+30 SET HLCNT=HLCNT+1
SET TPBCL=HLSTOP
SET TPBCLE=$$GET1^DIQ(40.7,HLSTOP,.01)
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 ;If more than 1 CLINIC found, set to 0 because we can't set it
+34 IF (HLCNT>1)
SET TPBCL=0
SET TPBCLE=""
+35 ;
+36 ;Start Loop of TPB ELIGIBILITY (#52.91)
+37 ;
+38 SET PSOTDFN=0
+39 FOR
SET PSOTDFN=$ORDER(^PS(52.91,PSOTDFN))
if 'PSOTDFN
QUIT
Begin DoDot:1
+40 ;
+41 ;Get DATE PHARMACY BENEFIT BEGAN
SET PSOTDBG=$$GET1^DIQ(52.91,PSOTDFN,1,"I")
+42 ;Get INACTIVATION OF BENEFIT DATE
SET PSOTIBD=$$GET1^DIQ(52.91,PSOTDFN,2,"I")
+43 ;
+44 ;Get PATIENT (#2) Specific Information
+45 SET DFN=PSOTDFN
DO DEM^VADPT
+46 SET PATNAM=$PIECE(VADM(1),U,1)
+47 IF '$LENGTH(PATNAM)
SET PATNAM="Missing Patient"
+48 SET PATSSN=$PIECE(VADM(2),U,2)
+49 SET PATSSN=$EXTRACT($PIECE(PATSSN,"-",3),1,5)
+50 ;
+51 ;Marking Rx's as TPB - Part 1
+52 DO EN^PSO160P1
+53 ;
+54 ;Inactivating Patient TPB's Benefit - Part 2
+55 DO EN^PSO160P2
+56 QUIT
End DoDot:1
+57 ;
+58 ;Process FINISH date (to be included in the Mailman messages)
+59 DO NOW^%DTC
SET ^XTMP("PSO160DR",$JOB,"FINISH")=%
+60 ;
+61 ;Mailman Message with Rx's marked as TPB - Part 1
+62 DO MAIL^PSO160P1
+63 ;
+64 ;Mailman Message with Patients inactivated from TPB - Part 2
+65 DO MAIL^PSO160P2
+66 ;
+67 LOCK -^XTMP("PSO160DR")
KILL ^XTMP("PSO160DR",$JOB)
+68 QUIT
+69 ;
PRTCL ;Adds the Pharmacy PSO TPB SD SUB protocol as a subscriber to the
+1 ;Scheduling protocol SDAM APPOINTMENT EVENTS
+2 ;
+3 NEW SDPRTCL,PSOPRTCL,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
+4 ;
+5 SET SDPRTCL=$ORDER(^ORD(101,"B","SDAM APPOINTMENT EVENTS",""))
+6 SET PSOPRTCL=$ORDER(^ORD(101,"B","PSO TPB SD SUB",""))
+7 ;
+8 IF 'SDPRTCL!'PSOPRTCL
QUIT
+9 ;
+10 ;Already a subscriber
+11 IF $DATA(^ORD(101,SDPRTCL,10,"B",PSOPRTCL))
QUIT
+12 ;
+13 SET X=PSOPRTCL
SET DIC="^ORD(101,"_SDPRTCL_",10,"
SET DLAYGO=101.01
+14 SET DA(1)=SDPRTCL
SET DIC(0)="L"
DO FILE^DICN
+15 QUIT
+16 ;
+17 ;
MGCHK ;If ther user installing the patch is not on the new Mail Group
+1 ;PSO TPB GROUP, include him/her as a member
+2 ;
+3 NEW MGIEN,USER,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
+4 SET USER=+@XPDGREF@("PSOUSER")
SET MGIEN=$ORDER(^XMB(3.8,"B","PSO TPB GROUP",""))
+5 IF 'MGIEN
QUIT
+6 IF $DATA(^XMB(3.8,MGIEN,1,"B",USER))
QUIT
+7 SET X=USER
SET DIC="^XMB(3.8,"_MGIEN_",1,"
SET DLAYGO=3.81
+8 SET DA(1)=MGIEN
SET DIC(0)="L"
DO FILE^DICN
+9 QUIT
