source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFET2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1RMPFET2 ;DDC/KAW-FREE TEXT PATIENT ADDRESS; [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3 ;;input: RMPFX,DFN,RMPFTYP
4 ;;output: None
5 Q:'$P(RMPFSYS,U,2) Q:$P(^RMPF(791810.1,RMPFTYP,0),U,10)
6AD1 W !!,"View patient address? YES// " D READ G END:$D(RMPFOUT)
7AD11 I $D(RMPFQUT) W !!,"Enter <Y> to view or edit the patient address information",!?6,"<N> or <RETURN> to continue." G AD1
8 G START:Y="",END:"Nn"[Y
9START D DISPLAY
10ASK F I=1:1 Q:$Y>21 W !
11 W !!,"Do you wish to edit the ROES address for this patient? NO// " D READ
12 G END:$D(RMPFOUT)
13ASK1 I $D(RMPFQUT) W !!,"Enter <Y> is you wish to edit the address for this patient.",!,"If the new address is complete, it will be transmitted to the",!,"DDC instead of the address in the DHCP patient file." G ASK
14 S:Y="" Y="N" S Y=$E(Y,1) I "YyNn"'[Y S RMPFQUT="" G ASK1
15 G END:"Nn"[Y W !!
16 S DA=RMPFX,DIE="^RMPF(791810,",DR="1.01;1.02;1.03;1.04;1.05;1.06"
17 D ^DIE
18TEMP W !!,"Is this a <T>emporary or <P>ermanent Address? P// "
19 D READ G END:$D(RMPFOUT)
20TEMP1 I $D(RMPFQUT) W !!,"Type <T> if this is a temporary address,",!?5,"<RETURN> or <P> if it a permanent address." G TEMP
21 S:Y="" Y="P" S Y=$E(Y,1) I "PpTt"'[Y S RMPFQUT="" G TEMP1
22 I "Pp"[Y S DA=RMPFX,DIE=791810,DR="1.07////@;1.08////@" D ^DIE G START
23 S DIE=791810,DA=RMPFX,DR="1.07;1.08" D ^DIE
24 G START
25END K AD,ST,BD,T,Z,X,Y,RMPFQUT,DA,DIE,D0,DR,DI,%,%DT,C,D,DIC,DQ,ED,I
26 K RMPFA,S,S1,S2,AA,A1,A2,A3,A4,A5,A6,A7,A8,L1,L2,L3,L4,L5,L6,L7,L8
27 K RMPFNAM,RMPFSSN,RMPFDOB,RMPFDOD,DISYS,VAERR,VAPA Q
28DISPLAY Q:'$D(DFN) Q:'$D(RMPFX) D PAT^RMPFUTL,ADD^VADPT
29 D SET,DISP
30DEND Q
31DISP D HEAD
32 W !?38,"|",!,"Addr [1]: ",A1,?38,"|",?41,"Addr [1]: ",L1
33 W !,"Addr [2]: ",A2,?38,"|",?41,"Addr [2]: ",L2
34 W !,"Addr [3]: ",A3,?38,"|",?41,"Addr [3]: ",L3
35 W !?4,"City: ",A4,?38,"|",?45,"City: ",L4
36 W !?3,"State: ",A5,?38,"|",?44,"State: ",L5
37 W !?5,"Zip: ",A6,?38,"|",?46,"Zip: ",L6
38 W ! W:A7'="" ?3,"Begin: ",A7 W ?38,"|" I L7'="" W ?44,"Begin: ",L7
39 W ! W:A8'="" ?5,"End: ",A8 W ?38,"|" I L8'="" W ?46,"End: ",L8
40 W !?38,"|",!?6,$S(A7="":"*** PERMANENT ADDRESS ***",1:"*** TEMPORARY ADDRESS ***"),?38,"|"
41 S MG="*** INCOMPLETE ADDRESS ***" I L4=""!(L5="")!(L6="") G WRIT
42 S MG="*** PERMANENT ADDRESS ***"
43 I L7'=""!(L8'="") S MG="*** TEMPORARY ADDRESS ***"
44WRIT W ?47,MG
45DISPE W ! F I=1:1:80 W "-"
46 K C,MG,I,J Q
47SET F I=1:1:8 S @("A"_I)=""
48 F I=1:1:4 S @("A"_I)=VAPA(I)
49 S A5=$P(VAPA(5),U,2)
50 S A6=VAPA(6),A7=$P(VAPA(9),U,2),A8=$P(VAPA(10),U,2)
51SET1 F I=1:1:8 S @("L"_I)=""
52 G SETE:'$D(^RMPF(791810,RMPFX,1)) S S1=^(1)
53 F I=1:1:4 S @("L"_I)=$P(S1,U,I)
54 S X=$P(S1,U,5) I X,$D(^DIC(5,X,0)) S X=$P(^(0),U,1) I X'="" S L5=X
55 S L6=$P(S1,U,6),L7=$P(S1,U,7) I L7 S Y=L7 D DD^%DT S L7=Y
56 S L8=$P(S1,U,8) I L8 S Y=L8 D DD^%DT S L8=Y
57SETE F I="A","L" F J=1:1:6 S @(I_J)=$E(@(I_J),1,28)
58 K X,I Q
59HEAD W @IOF,!?32,"PATIENT ADDRESS"
60 W !,"Station: ",RMPFSTAP,?68,RMPFDAT
61 W !,"Patient: ",$E(RMPFNAM,1,25),?40,"SSN: ",RMPFSSN,?62,"DOB: ",RMPFDOB
62 W ! F I=1:1:80 W "-"
63 W !?10,"DHCP PATIENT FILE",?38,"|",?51,"ROES PATIENT ADDRESS"
64 W !?10,"------------------",?38,"|",?51,"---------------------"
65 Q
66READ K RMPFOUT,RMPFQUT
67 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
68 I Y?1"^".E S (RMPFOUT,Y)="" Q
69 S:Y?1"?".E (RMPFQUT,Y)=""
70 Q
71CONT F I=1:1 Q:$Y>21 W !
72 W !,"Enter <RETURN> to continue or <^> to exit: " D READ
73 Q
Note: See TracBrowser for help on using the repository browser.