source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO160P1.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1PSO160P1 ;BIR/BHW-Patch 160 Post Install routine - Part 1 ;11/24/03
2 ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
3 ;
4EN ;Begin Processing. Entry point for PSO160DR
5 N PSRX,PSRXLDT,PSOTCNT,PSRXPROV,NVAPROV,PSRXDIV,PSORXTPB,PRVPSTAT
6 N NVAPROVE,PSRXDRG,PROVTYPE,PSRXRX,DIE,DR,DA
7 ;
8 ;If Date of Pharmacy Benefit = Inactivation of Benefit Date Don't Process
9 I PSOTDBG="" Q
10 I PSOTDBG=PSOTIBD Q
11 ;
12 S PSOTCNT=0
13 F S PSOTCNT=$O(^PS(55,PSOTDFN,"P",PSOTCNT)) Q:'PSOTCNT D
14 . ;Get Prescription Number
15 . S PSRX=$G(^PS(55,PSOTDFN,"P",PSOTCNT,0)) Q:'$L(PSRX)
16 . S PSRXLDT=$$GET1^DIQ(52,PSRX,21,"I") ;Get LOGIN DATE
17 . S PSRXLDT=$P(PSRXLDT,".",1) Q:'PSRXLDT
18 . ;
19 . ;Determine if Login Date within Benefit Range, If not Don't Process
20 . I (PSRXLDT<PSOTDBG)!((PSOTIBD'="")&(PSRXLDT>PSOTIBD)) Q
21 . ;
22 . ;Get PRESCRIPTION (#52) field TPB (#201), If already set, Don't Process
23 . S PSRXTPB=$$GET1^DIQ(52,PSRX,201,"I") Q:PSRXTPB
24 . ;
25 . ;Get Provider, If not defined OR not an NVA provider, Don't Process
26 . S PSRXPROV=$$GET1^DIQ(52,PSRX,4,"I") Q:'PSRXPROV
27 . S NVAPROV=$$GET1^DIQ(200,PSRXPROV,53.91,"I") Q:'NVAPROV
28 . ;
29 . ;Get Previous PATIENT STATUS (#3) prior to setting to NON-VA
30 . S PRVPSTAT=$$GET1^DIQ(52,PSRX,3)
31 . ;
32 . ;**********************************************************************
33 . ;Set TPB (#201) ="YES" & PATIENT STATUS (#3) = NON-VA in PRESCRIPTION (#52)
34 . S DIE="^PSRX(",DA=PSRX,DR="201///YES"
35 . S:$G(PATSTATC)'="" DR=DR_";3///"_PATSTATC
36 . D ^DIE K DIE,DA,DR
37 . ;
38 . ;If Unique TPB Clinic, Reset RX CLINIC to that clinic (Save Previous value)
39 . I TPBCL S DIE="^PSRX(",DA=PSRX,DR="5///"_TPBCLE D ^DIE K DIE,DA,DR
40 . ;
41 . ;**********************************************************************
42 . ;
43 . ;Get display fields and Set Temporary DB for E-mail Report
44 . S TPBCLP=$$GET1^DIQ(52,PSRX,5) ;Get Clinic
45 . S PSRXDRG=$$GET1^DIQ(52,PSRX,6) ;Get Drug (External Form)
46 . S PSRXRX=$$GET1^DIQ(52,PSRX,.01) ;Get Rx Number (External Form)
47 . I '$L(PSRXRX) S PSRXRX=PSRX
48 . S NVAPROVE=$$GET1^DIQ(200,PSRXPROV,.01) ;Get Provider Name (External Form)
49 . S PROVTYPE=$$GET1^DIQ(200,PSRXPROV,53.6) ;Get Provider type (External Form)
50 . S PSRXDIV=$$GET1^DIQ(52,PSRX,20) ;Get Division (External Form)
51 . I '$L(PSRXDIV) S PSRXDIV="Unknown Division"
52 . I $L(PROVTYPE) S NVAPROVE="*"_NVAPROVE
53 . ;
54 . ;Create Temporary global for E-mail Message
55 . S TEMP=PATSSN_U_PSRXDRG_U_NVAPROVE_U_TPBCLP_U_TPBCLE_U_PRVPSTAT_U_"NON-VA"_U_TPBCL
56 . S ^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX)=TEMP
57 . Q
58 Q
59 ;
60 ;======================================================================
61 ;Loop Temporary Global and Format for E-mail
62MAIL ;
63 N PSRXDIV,PATNAM,PSRXRX,PSRXDRG,PATSSN,NVAPROVE,EMCNT,PATCNT,RXCNT,DASH
64 N DIVFLAG,PNAM,RXSTS,TEMP,TPBRX,RX,L,DATA,PATSSNL
65 S (PSRXDIV,PATNAM,PSRXRX,PSRXDRG,PATSSN,NVAPROVE)="",EMCNT=1
66 S (PATCNT,RXCNT,DIVFLAG,PATSSNL)=0,$P(DASH,"-",80)=""
67 ;
68 ;Create Header for Mail Report
69 D STORELN("The Post-Install process for PSO*7*160 - Part 1 successfully completed.")
70 D STORELN(" ")
71 D STORELN("Started on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"START"))))
72 D STORELN("Finished on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"FINISH"))))
73 D STORELN(" ")
74 ;
75 ;If no entries created above, skip reporting
76 I '$L($O(^XTMP("PSO160P1",$J,"T",""))) D G SEND
77 . D STORELN("No prescriptions have been marked as TPB (Transitional Pharmacy).")
78 . Q
79 ;
80 D STORELN("The following Prescriptions have been marked as TPB (Transitional Pharmacy")
81 D STORELN("Benefits) prescription by the post-install process.")
82 D STORELN(" ")
83 ;
84 F S PSRXDIV=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV)) Q:'$L(PSRXDIV) D
85 . ;Check if Division Changed
86 . I DIVFLAG'=PSRXDIV D
87 . . ;Print Sub-Header
88 . . D STORELN("DIVISION: "_PSRXDIV)
89 . . D STORELN(DASH)
90 . . D STORELN($E("Patient Name (LAST4SSN)"_SP,1,25)_$E("Rx#"_SP,1,10)_$E("DRUG"_SP,1,24)_$E("PROVIDER"_SP,1,20))
91 . . D STORELN(DASH)
92 . . Q
93 . E S DIVFLAG=PSRXDIV
94 . ;
95 . S PATNAM=""
96 . F S PATNAM=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM)) Q:'$L(PATNAM) D
97 . . S PSRXRX="",PATCNT=PATCNT+1
98 . . ;
99 . . F S PSRXRX=$O(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX)) Q:'$L(PSRXRX) D
100 . . . S DATA=$G(^XTMP("PSO160P1",$J,"T",PSRXDIV,PATNAM,PSRXRX))
101 . . . S PATSSN=$P(DATA,U,1),PSRXDRG=$P(DATA,U,2),NVAPROVE=$P(DATA,U,3),TPBCLP=$P(DATA,U,4)
102 . . . S TPBCLE=$P(DATA,U,5),PRVPSTAT=$P(DATA,U,6),PATSTAT=$P(DATA,U,7),TPBCL=$P(DATA,U,8)
103 . . . ;Line 1
104 . . . S TEMP="",RXCNT=RXCNT+1
105 . . . S TEMP=$E(PATNAM_SP,1,20)
106 . . . S TEMP=$E($E(PATNAM,1,16)_" ("_$E(PATSSN,1,5)_")"_$E(SP,1,6-PATSSNL)_SP,1,25)
107 . . . S TEMP=TEMP_$E(PSRXRX_SP,1,11)
108 . . . S TEMP=TEMP_$E(PSRXDRG_SP,1,22)_" "
109 . . . S TEMP=TEMP_$E(NVAPROVE_SP,1,20)
110 . . . D STORELN(TEMP)
111 . . . ;Line 2 (clinic Line)
112 . . . S TEMP=$E(SP,1,25)
113 . . . I (TPBCLP'=TPBCLE)&(TPBCL) S TEMP=TEMP_"Clinic: Old: "_$E(TPBCLP,1,16)_" New: "_$E(TPBCLE,1,17)
114 . . . E S TEMP=TEMP_"Clinic: "_$E(TPBCLP,1,46)
115 . . . D STORELN(TEMP)
116 . . . ;Line 3 (Patient status line)
117 . . . S TEMP=$E(SP,1,25)
118 . . . I PRVPSTAT'=PATSTAT S TEMP=TEMP_"Rx Patient Status: Old: "_$E(PRVPSTAT,1,17)_" New: "_$E(PATSTAT_SP,1,7)
119 . . . E S TEMP=TEMP_"Rx Patient Status: "_$E(PATSTAT_SP,1,25)
120 . . . D STORELN(TEMP)
121 . . . D STORELN(" ")
122 . . . Q
123 . . Q
124 . ;Print Totals only if End of Division
125 . D STORELN("Total: "_PATCNT_" Patients and "_RXCNT_" Prescriptions")
126 . D STORELN(" ")
127 . D STORELN("* Non-VA Provider has a PROVIDER TYPE")
128 . S (PATCNT,RXCNT)=0
129 . Q
130 ;======================================================================
131SEND ;Send Completion E-mail.
132 N DIFROM
133 ;
134 ;Setup Mailman Variables
135 S XMSUB="PSO*7*160 - LIST OF PRESCRIPTIONS MARKED AS TPB"
136 S XMDUZ="Patch PSO*7*160" D SXMY^PSOTPCUL("PSO TPB GROUP")
137 S XMY(DUZ)="",XMTEXT="^XTMP(""PSO160P1"","_$J_",""M"","
138 ;
139 ;Send E-mail
140 D ^XMD
141 K XMTEXT,XMSUB,XMDUZ,XMY
142 S:$D(ZTQUEUED) ZTREQ="@"
143 Q
144 ;
145 ;======================================================================
146 ;Store E-mail line in "M" subscript.
147STORELN(LINE) ;
148 S EMCNT=EMCNT+1
149 S ^XTMP("PSO160P1",$J,"M",EMCNT)=LINE
150 Q
Note: See TracBrowser for help on using the repository browser.