source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WV22PST.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1WV22PST ;HIOFO/FT-WV*1*22 POST INSTALLATION ROUTINE; 1/30/07 9:29am
2 ;;1.0;WOMEN'S HEALTH;**22**;Sep 30, 1998;Build 1
3 ;
4ENV ;Main entry point for Environment check point.
5 ;
6 S XPDABORT=""
7 D PROGCHK(.XPDABORT) ;checks programmer variables
8 I XPDABORT="" K XPDABORT
9 Q
10 ;
11POST ;Main entry point for Post-init items.
12 ;
13 ;Change the CPT codes for mammograms in file 790.2
14 N X,Y,Z,OLDCPT,NEWCPT
15 F X="MAMMOGRAM DX BILAT","MAMMOGRAM DX UNILAT","MAMMOGRAM SCREENING" D
16 . S Y=$O(^WV(790.2,"B",X,0)) Q:Y'>0
17 . S Z=$G(^WV(790.2,Y,0)) Q:Z=""
18 . S OLDCPT=$P(Z,"^",8) I OLDCPT'=76090,OLDCPT'=76091,OLDCPT'=76092 Q
19 . S NEWCPT=$S(X="MAMMOGRAM DX BILAT":77056,X="MAMMOGRAM DX UNILAT":77055,X="MAMMOGRAM SCREENING":77057,1:"") Q:NEWCPT=""
20 . S $P(Z,"^",8)=NEWCPT,^WV(790.2,Y,0)=Z
21 . ; update cross-reference
22 . K ^WV(790.2,"AC",OLDCPT,Y)
23 . S ^WV(790.2,"AC",NEWCPT,Y)=""
24 Q
25 ;
26PROGCHK(XPDABORT) ;checks for necessary programmer variables
27 ;
28 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
29 .D BMES^XPDUTL("*****")
30 .D MES^XPDUTL("Your programming variables are not set up properly.")
31 .D MES^XPDUTL("Installation aborted.")
32 .D MES^XPDUTL("*****")
33 .S XPDABORT=2
34 Q
Note: See TracBrowser for help on using the repository browser.