source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO160DR.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1PSO160DR ;BIR/BHW-Patch 160 Post Install routine - Driver ;11/24/03
2 ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
3 ;External reference to ^SC( supported by DBIA 2675
4 ;External reference to ^ORD(101, is supp. by DBIA# 872
5 ;
6 ;Setup TaskManager Task
7 D MGCHK,PRTCL S ZTDTH=@XPDGREF@("PSO160Q"),ZTIO=""
8 S ZTRTN="START^PSO160DR",ZTDESC="Post Install for patch PSO*7*160"
9 D ^%ZTLOAD K ZTDTH,ZTRTN,ZTIO,ZTDESC
10 I $D(ZTSK)&('$D(ZTQUEUED)) D BMES^XPDUTL("Task Queued!")
11 Q
12 ;
13START ;
14 N PSOTDFN,PSOTDBG,PSOTIBD,TPBCL,PATNAM,PATSSN,VADM,DFN,HLIEN,HLSTOP,SP
15 N PSOTCNT,PATCNT,RXCNT,EMCNT,HLSTOPC,HLCNT,PATSTATC,PATSTAT,X1,X2,X,%
16 N TPBCLP,TPBCLE
17 ;
18 K ^XTMP("PSO160P1",$J),^XTMP("PSO160P2",$J)
19 L +^XTMP("PSO160DR"):0 I '$T W "Already running." S:$D(ZTQUEUED) ZTREQ="@" Q
20 D NOW^%DTC S ^XTMP("PSO160DR",$J,"START")=%
21 I '$G(DT) S DT=$$DT^XLFDT
22 S $P(SP," ",80)="",X1=DT,X2=+90 D C^%DTC
23 S (^XTMP("PSO160P1",0),^XTMP("PSO160P2",0))=$G(X)_"^"_DT
24 ;
25 ;Begin Processing. Entry point for Task
26 S (PSOTDFN,PATCNT,RXCNT)=0,EMCNT=1
27 ;
28 ;Find NON-VA entry in RX PATIENT STATUS file (#53)
29 S (PATSTATC,PATSTAT)=0
30 F S PATSTAT=$O(^PS(53,"B",PATSTAT)) Q:'$L(PATSTAT) D
31 . I $$UP^XLFSTR(PATSTAT)="NON-VA" D
32 . . S PATSTATC=$O(^PS(53,"B",PATSTAT,""))
33 . . Q
34 . Q
35 I 'PATSTATC S PATSTATC=""
36 ;
37 ;Find TPB Clinic (Used in TPB Eligibility Loop)
38 S (HLIEN,HLCNT)=0,(HLSTOP,HLSTOPC,TPBCL,TPBCLE)=""
39 F S HLIEN=$O(^SC(HLIEN)) Q:'HLIEN D
40 . S HLSTOP=$$GET1^DIQ(44,HLIEN,8,"I") Q:'HLSTOP
41 . S HLSTOPC=$$GET1^DIQ(40.7,HLSTOP,1) Q:'HLSTOPC
42 . I (HLSTOPC=161) D
43 . . S HLCNT=HLCNT+1,TPBCL=HLSTOP,TPBCLE=$$GET1^DIQ(40.7,HLSTOP,.01)
44 . . Q
45 . Q
46 ;If more than 1 CLINIC found, set to 0 because we can't set it
47 I (HLCNT>1) S TPBCL=0,TPBCLE=""
48 ;
49 ;Start Loop of TPB ELIGIBILITY (#52.91)
50 ;
51 S PSOTDFN=0
52 F S PSOTDFN=$O(^PS(52.91,PSOTDFN)) Q:'PSOTDFN D
53 . ;
54 . S PSOTDBG=$$GET1^DIQ(52.91,PSOTDFN,1,"I") ;Get DATE PHARMACY BENEFIT BEGAN
55 . S PSOTIBD=$$GET1^DIQ(52.91,PSOTDFN,2,"I") ;Get INACTIVATION OF BENEFIT DATE
56 . ;
57 . ;Get PATIENT (#2) Specific Information
58 . S DFN=PSOTDFN D DEM^VADPT
59 . S PATNAM=$P(VADM(1),U,1)
60 . I '$L(PATNAM) S PATNAM="Missing Patient"
61 . S PATSSN=$P(VADM(2),U,2)
62 . S PATSSN=$E($P(PATSSN,"-",3),1,5)
63 . ;
64 . ;Marking Rx's as TPB - Part 1
65 . D EN^PSO160P1
66 . ;
67 . ;Inactivating Patient TPB's Benefit - Part 2
68 . D EN^PSO160P2
69 . Q
70 ;
71 ;Process FINISH date (to be included in the Mailman messages)
72 D NOW^%DTC S ^XTMP("PSO160DR",$J,"FINISH")=%
73 ;
74 ;Mailman Message with Rx's marked as TPB - Part 1
75 D MAIL^PSO160P1
76 ;
77 ;Mailman Message with Patients inactivated from TPB - Part 2
78 D MAIL^PSO160P2
79 ;
80 L -^XTMP("PSO160DR") K ^XTMP("PSO160DR",$J)
81 Q
82 ;
83PRTCL ;Adds the Pharmacy PSO TPB SD SUB protocol as a subscriber to the
84 ;Scheduling protocol SDAM APPOINTMENT EVENTS
85 ;
86 N SDPRTCL,PSOPRTCL,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
87 ;
88 S SDPRTCL=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",""))
89 S PSOPRTCL=$O(^ORD(101,"B","PSO TPB SD SUB",""))
90 ;
91 I 'SDPRTCL!'PSOPRTCL Q
92 ;
93 ;Already a subscriber
94 I $D(^ORD(101,SDPRTCL,10,"B",PSOPRTCL)) Q
95 ;
96 S X=PSOPRTCL,DIC="^ORD(101,"_SDPRTCL_",10,",DLAYGO=101.01
97 S DA(1)=SDPRTCL,DIC(0)="L" D FILE^DICN
98 Q
99 ;
100 ;
101MGCHK ;If ther user installing the patch is not on the new Mail Group
102 ;PSO TPB GROUP, include him/her as a member
103 ;
104 N MGIEN,USER,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
105 S USER=+@XPDGREF@("PSOUSER"),MGIEN=$O(^XMB(3.8,"B","PSO TPB GROUP",""))
106 I 'MGIEN Q
107 I $D(^XMB(3.8,MGIEN,1,"B",USER)) Q
108 S X=USER,DIC="^XMB(3.8,"_MGIEN_",1,",DLAYGO=3.81
109 S DA(1)=MGIEN,DIC(0)="L" D FILE^DICN
110 Q
Note: See TracBrowser for help on using the repository browser.