| [1161] | 1 | BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
|
|---|
| [1187] | 2 | ;;1.6T2;BSDX;;May 16, 2011
|
|---|
| [1161] | 3 | ; Licensed under LGPL
|
|---|
| [614] | 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | ACCTYPD(BSDXY,BSDXVAL) ;EP
|
|---|
| 7 | ;Entry point for debugging
|
|---|
| 8 | ;
|
|---|
| 9 | ;D DEBUG^%Serenji("ACCTYP^BSDX14(.BSDXY,BSDXVAL)")
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | ACCTYP(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 | ;
|
|---|
| 60 | ERR(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 | ;
|
|---|
| 68 | ERROR ;
|
|---|
| 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
|
|---|
