source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOBAI.m@ 767

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PSOBAI ;BIR/EJW - BAD ADDRESS PROCESSING ;02/02/2006
2 ;;7.0;OUTPATIENT PHARMACY;**233,258,268,264**;DEC 1997;Build 19
3 ;
4 ;External reference EN^DGREGAED supported by DBIA 4198
5 ;External reference UPDATE^DGADDUTL supported by DBIA 4886
6 ;External reference ^DPT( supported by DBIA 5031
7 ;
8CHKADDR(PSODFN,WARN,UPDATE) ; CHECK ADDRESS BY PATIENT
9 ;Input: PSODFN - PATIENT file (#2) IEN
10 ; WARN - Display warning (optional)
11 ; UPDATE - If bad address flagged, prompt to update patient address (optional)
12 ;If calling from patient selection, if bad, even if there is an active temporary address, prompt to update the address
13 N PSOBADR,PSOTEMP
14 I PSODFN="" Q
15 S PSOBADR=$$BADADR^DGUTL3(PSODFN)
16 I PSOBADR D
17 .S PSOTEMP=$$CHKTEMP(PSODFN)
18 .I $G(WARN) D
19 ..D WARN1
20 ..I $G(UPDATE) D UPDATE Q
21 ..D PAUSE
22 Q
23 ;
24CHKRX(PSORX) ;CHECK ADDRESS BY RX
25 ;Input: PSORX - PRESCRIPTION file (#52) IEN
26 ;Output: PSOBADR - Bad Address Indicator_"^"_temporary address or not
27 N PSOBADR,PSODFN,PSOTEMP
28 S PSOBADR=""
29 I PSORX="" Q 0
30 S PSODFN=$P($G(^PSRX(PSORX,0)),"^",2) I PSODFN="" Q 0
31 S PSOBADR=$$BADADR^DGUTL3(PSODFN)
32 I PSOBADR S PSOTEMP=$$CHKTEMP(PSODFN)
33 S PSOBADR=PSOBADR_"^"_$G(PSOTEMP)
34 Q PSOBADR
35 ;
36WARN1 ;
37 W !!,?8,"WARNING: The patient address is indicated as a bad"
38 W !,?17,"address (",$S(PSOBADR=1:"UNDELIVERABLE",PSOBADR=2:"HOMELESS",1:"OTHER"),")."
39 I $G(PSOTEMP) W !,?17,"* Temporary address is active *" Q
40 W !,?17,"Medication will not be mailed to"
41 W !,?17,"the patient until the address has been"
42 W !,?17,"corrected.",!
43 Q
44CHKTEMP(PSODFN) ; see if active temporary address
45 ;Input: PSODFN - PATIENT file (#2) IEN
46 N DFN,VAPA
47 S DFN=PSODFN,PSOTEMP=0
48 D 6^VADPT I +VAPA(9) S PSOTEMP=1
49 Q PSOTEMP
50 ;
51UPDATE ;
52 N PSOSEL,DA
53 I '$D(PSOPAR) D ^PSOLSET
54 I '$P($G(PSOPAR),"^",22),'$D(^XUSEC("PSO ADDRESS UPDATE",+$G(DUZ))) D PAUSE Q
55 K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to update the address/phone"
56 D ^DIR K DIR
57 I Y'=1 Q
58 L +^DPT(PSODFN):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D MSG,PAUSE Q
59 K DIR S DIR(0)="SAO^P:PERMANENT;T:TEMPORARY;B:BOTH"
60 S DIR("A")=" Update (P)ermanent address, (T)emporary, or (B)oth: "
61 S DIR("B")="BOTH" D ^DIR
62 I $D(DIRUT) G ULK
63 S PSOSEL=Y
64 I PSOSEL="P"!(PSOSEL="B") D
65 .;D UPDATE^DGADDUTL(PSODFN,"PERM") - THIS CALL CLEARS BAI FLAG INAPPROPRIATELY SO USE FOLLOWING TO UPDATE PERMANENT ADDRESS/PHONE INSTEAD 5/29/06
66 .N PSOFLG
67 .S PSOFLG(1)=1 D EN^DGREGAED(PSODFN,.PSOFLG) W !
68 S DA=PSODFN,DIE="^DPT(",DR=".134" D ^DIE W !
69 I PSOSEL="P" D ULK Q
70 I PSOSEL="B"!(PSOSEL="T") D UPDATE^DGADDUTL(PSODFN,"TEMP"),ULK,PAUSE
71 Q
72ULK ;
73 L -^DPT(PSODFN)
74 Q
75 ;
76PAUSE ;
77 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
78 Q
79 ;
80MSG ;
81 S VALMSG="Patient Data is being edited by another user!"
82 Q
83 ;
Note: See TracBrowser for help on using the repository browser.