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

Last change on this file since 789 was 614, checked in by Sam Habiel, 15 years ago

Initial committ of scheduling package

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