source: FOIAVistA/tag/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PX157PST.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1PX157PST ;ALB/SCK - PX*1.0*157 POST INIT INSTALL
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**157**;Aug 12, 1996
3 ;
4EN ; Edit Education Topics VA-ADVANCE DIRECTIVES & VA-ADVANCED DIRECTIVES SCREENING
5 ; -- modifying to "advance directives" terminology.
6EN1 ;check VA-ADVANCED DIRECTIVES SCREENING
7 S FIX1=0,FIX2=0,IEN1=0,U="^",WD1="VA-ADVANCED DIRECTIVES SCREENING",WD2="Advanced Directive Screening"
8 S WD1N="VA-ADVANCE DIRECTIVES SCREENING",WD2N="Advance Directives Screening"
9 S WD(1)="determine if the patient should receive Advanced Directive education. "
10 S WDN(1)="determine if the patient should receive Advance Directives education."
11 S WD(2)="Advanced Directive education. "
12 S WDN(2)="Advance Directives education."
13 S IEN1=$O(^AUTTEDT("B",WD1,IEN1)) I IEN1="" G EN2
14 S REDT=^AUTTEDT(IEN1,0)
15 I $P(REDT,U)'=WD1!($P(REDT,U,4)'=WD2) G EN2
16 ;I ^AUTTEDT(IEN1,11,2,0)'=WD(1) G EN2
17 ;I ^AUTTEDT(IEN1,12,4,0)'=WD(2) G EN2
18SET1 ;SET CORRECT WORDING
19 S FIX1=1
20 S DA=IEN1,DR=".01////^S X=WD1N",DIE="^AUTTEDT(" D ^DIE
21 S DA=IEN1,DR=".04////^S X=WD2N",DIE="^AUTTEDT(" D ^DIE
22 S ^AUTTEDT(IEN1,11,2,0)=WDN(1),^AUTTEDT(IEN1,12,4,0)=WDN(2)
23EN2 ;check VA-ADVANCED DIRECTIVES
24 S IEN2=0,WD1A="VA-ADVANCED DIRECTIVES",WD2A="Advanced Directives"
25 S WD1AN="VA-ADVANCE DIRECTIVES",WD2AN="Advance Directives"
26 S WDA(1)="The patient and family will identify the implications of advanced"
27 S WDA(2)="1. Explain what an advanced directive is."
28 S WDA(3)="2. Explain the difference between advanced directives and a living will."
29 S WDA(4)="5. Identify a social worker to contact for furthur information as appropriate."
30 S WDAN(1)="The patient and family will identify the implications of advance"
31 S WDAN(2)="1. Explain what an advance directives is."
32 S WDAN(3)="2. Explain the difference between advance directives and a living will."
33 S WDAN(4)="5. Identify a social worker to contact for further information as appropriate."
34 S IEN2=$O(^AUTTEDT("B",WD1A,IEN2)) I IEN2="" G EN3
35 S REDT=^AUTTEDT(IEN2,0)
36 I $P(REDT,U)'=WD1A!($P(REDT,U,4)'=WD2A) G EN3
37 I ^AUTTEDT(IEN2,11,1,0)'=WDA(1) G EN3
38 I ^AUTTEDT(IEN2,12,1,0)'=WDA(2) G EN3
39 I ^AUTTEDT(IEN2,12,3,0)'=WDA(3) G EN3
40 I ^AUTTEDT(IEN2,12,10,0)'=WDA(4) G EN3
41SET2 ;SET CORRECT WORDING
42 S FIX2=1
43 S DA=IEN2,DR=".01////^S X=WD1AN",DIE="^AUTTEDT(" D ^DIE
44 S DA=IEN2,DR=".04////^S X=WD2AN",DIE="^AUTTEDT(" D ^DIE
45 S ^AUTTEDT(IEN2,11,1,0)=WDAN(1)
46 S ^AUTTEDT(IEN2,12,1,0)=WDAN(2),^AUTTEDT(IEN2,12,3,0)=WDAN(3)
47 S ^AUTTEDT(IEN2,12,10,0)=WDAN(4)
48EN3 ;MAIL MSG
49END ;EXIT PATH
50 D MAIL
51 K DA,DR,DIE,IEN,IEN1,IEN2,WD,WDN,WDA,WDAN,WD1,WD1N,WD2,WD2N,WD1A,WD1AN,WD2A,WD2AN,FIX1,FIX2,REDT
52 Q
53MAIL ;Send results of Educ Topic fix in a mail message to initiator
54 N I,XMSUB,XMTEXT,XMDUZ,XMY,DIFROM
55 S XMSUB="Patch PX*1.0*157 Educ topic modification completed"
56 S XMDUZ="Patch PX*1.0*157 Educ topic modify job"
57 S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
58 S XMTEXT="^TMP(""PXTXT"",$J,"
59 K ^TMP("PXTXT",$J)
60 ; set up header and count
61 S I=3
62 S ^TMP("PXTXT",$J,1)="The modification of Education Topics: VA-Advanced Directives and"
63 S ^TMP("PXTXT",$J,2)="VA-Advanced Directives Screening, has completed"
64 S ^TMP("PXTXT",$J,I)="",I=I+1
65 S ^TMP("PXTXT",$J,I)=""
66 I FIX1=0 D
67 . S I=I+1,^TMP("PXTXT",$J,I)=" *** ERROR ALERT ***"
68 . S I=I+1,^TMP("PXTXT",$J,I)="Could NOT fix topic VA-Advanced Directives Screening, data did NOT "
69 . S I=I+1,^TMP("PXTXT",$J,I)="match national data base"
70 I FIX1>0 D
71 . S I=I+1,^TMP("PXTXT",$J,I)=" *** CHANGED ***"
72 . S I=I+1,^TMP("PXTXT",$J,I)="Modified topic VA-Advanced Directives Screening for verbiage"
73 . S I=I+1,^TMP("PXTXT",$J,I)="correction where used"
74 S I=I+1,^TMP("PXTXT",$J,I)=""
75 I FIX2=0 D
76 . S I=I+1,^TMP("PXTXT",$J,I)=" *** ERROR ALERT ***"
77 . S I=I+1,^TMP("PXTXT",$J,I)="Could NOT fix topic VA-Advanced Directives, data did NOT"
78 . S I=I+1,^TMP("PXTXT",$J,I)="match national data base"
79 I FIX2>0 D
80 . S I=I+1,^TMP("PXTXT",$J,I)=" *** CHANGED ***"
81 . S I=I+1,^TMP("PXTXT",$J,I)="Modified topic VA-Advanced Directives for verbiage correction"
82 . S I=I+1,^TMP("PXTXT",$J,I)="where used"
83 D ^XMD ;send results
84 Q
Note: See TracBrowser for help on using the repository browser.