source: Scheduling/trunk/m/BSDX14.m@ 1173

Last change on this file since 1173 was 1161, checked in by Sam Habiel, 14 years ago

Added LGPL license to routines

File size: 2.0 KB
Line 
1BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
2 ;;1.5;BSDX;;Apr 28, 2011
3 ; Licensed under LGPL
4 ;
5 ;
6ACCTYPD(BSDXY,BSDXVAL) ;EP
7 ;Entry point for debugging
8 ;
9 ;D DEBUG^%Serenji("ACCTYP^BSDX14(.BSDXY,BSDXVAL)")
10 Q
11 ;
12ACCTYP(BSDXY,BSDXVAL) ;EP
13 ;Called by BSDX ADD/EDIT ACCESS TYPE
14 ;Add/Edit ACCESS TYPE entry
15 ;BSDXVAL is IEN|NAME|INACTIVE|COLOR|RED|GREEN|BLUE
16 ;If IEN=0 Then this is a new ACCTYPE
17 ;Test Line:
18 ;D ACCTYP^BSDX14(.RES,"0|ORAL HYGIENE|false|Red")
19 ;
20 S X="ERROR^BSDX14",@^%ZOSF("TRAP")
21 N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXNAM
22 S BSDXY="^BSDXTMP("_$J_")"
23 S ^BSDXTMP($J,0)="I00020ACCESSTYPEID^T00030ERRORTEXT"_$C(30)
24 I BSDXVAL="" D ERR(0,"BSDX14: Invalid null input Parameter") Q
25 S BSDXIEN=$P(BSDXVAL,"|")
26 I +BSDXIEN D
27 . S BSDX="EDIT"
28 . S BSDXIENS=BSDXIEN_","
29 E D
30 . S BSDX="ADD"
31 . S BSDXIENS="+1,"
32 ;
33 S BSDXNAM=$P(BSDXVAL,"|",2)
34 I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q
35 ;
36 ;Prevent adding entry with duplicate name
37 I $D(^BSDXTYPE("B",BSDXNAM)),$O(^BSDXTYPE("B",BSDXNAM,0))'=BSDXIEN D Q
38 . D ERR(0,"BSDX14: Cannot have two Access Types with the same name.")
39 . Q
40 ;
41 S BSDXINA=$P(BSDXVAL,"|",3)
42 S BSDXINA=$S(BSDXINA="YES":1,1:0)
43 ;
44 S BSDXFDA(9002018.35,BSDXIENS,.01)=$P(BSDXVAL,"|",2) ;NAME
45 S BSDXFDA(9002018.35,BSDXIENS,.02)=BSDXINA ;INACTIVE
46 S BSDXFDA(9002018.35,BSDXIENS,.04)=$P(BSDXVAL,"|",4) ;COLOR
47 S BSDXFDA(9002018.35,BSDXIENS,.05)=$P(BSDXVAL,"|",5) ;RED
48 S BSDXFDA(9002018.35,BSDXIENS,.06)=$P(BSDXVAL,"|",6) ;GREEN
49 S BSDXFDA(9002018.35,BSDXIENS,.07)=$P(BSDXVAL,"|",7) ;BLUE
50 K BSDXMSG
51 I BSDX="ADD" D
52 . K BSDXIEN
53 . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
54 . S BSDXIEN=+$G(BSDXIEN(1))
55 E D
56 . D FILE^DIE("","BSDXFDA","BSDXMSG")
57 S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(30)_$C(31)
58 Q
59 ;
60ERR(BSDXERID,ERRTXT) ;Error processing
61 S:'+$G(BSDXI) BSDXI=999999
62 S BSDXI=BSDXI+1
63 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
64 S BSDXI=BSDXI+1
65 S ^BSDXTMP($J,BSDXI)=$C(31)
66 Q
67 ;
68ERROR ;
69 D ^%ZTER
70 I '+$G(BSDXI) N BSDXI S BSDXI=999999
71 S BSDXI=BSDXI+1
72 D ERR(0,"BSDX14 M Error: <"_$G(%ZTERROR)_">")
73 Q
Note: See TracBrowser for help on using the repository browser.