BSDX14 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
ACCTYPD(BSDXY,BSDXVAL) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("ACCTYP^BSDX14(.BSDXY,BSDXVAL)")
Q
;
ACCTYP(BSDXY,BSDXVAL) ;EP
;Called by BSDX ADD/EDIT ACCESS TYPE
;Add/Edit ACCESS TYPE entry
;BSDXVAL is IEN|NAME|INACTIVE|COLOR|RED|GREEN|BLUE|PREVENT_ACCESS
;If IEN=0 Then this is a new ACCTYPE
;Test Line:
;D ACCTYP^BSDX14(.RES,"0|ORAL HYGIENE|false|Red")
;
S X="ERROR^BSDX14",@^%ZOSF("TRAP")
N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXNAM
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020ACCESSTYPEID^T00030ERRORTEXT"_$C(30)
I BSDXVAL="" D ERR(0,"BSDX14: Invalid null input Parameter") Q
S BSDXIEN=$P(BSDXVAL,"|")
I +BSDXIEN D
. S BSDX="EDIT"
. S BSDXIENS=BSDXIEN_","
E D
. S BSDX="ADD"
. S BSDXIENS="+1,"
;
S BSDXNAM=$P(BSDXVAL,"|",2)
I BSDXNAM="" D ERR(0,"BSDX14: Invalid null Access Type name.") Q
;
;Prevent adding entry with duplicate name
I $D(^BSDXTYPE("B",BSDXNAM)),$O(^BSDXTYPE("B",BSDXNAM,0))'=BSDXIEN D Q
. D ERR(0,"BSDX14: Cannot have two Access Types with the same name.")
. Q
;setup inactive flag
S BSDXINA=$P(BSDXVAL,"|",3)
S BSDXINA=$S(BSDXINA="YES":1,1:0)
;setup prevent access flag
S BSDXPA=$P(BSDXVAL,"|",8)
S BSDXPA=$S(BSDXPA="YES":1,1:0)
;
S BSDXFDA(9002018.35,BSDXIENS,.01)=$P(BSDXVAL,"|",2) ;NAME
S BSDXFDA(9002018.35,BSDXIENS,.02)=BSDXINA ;INACTIVE
S BSDXFDA(9002018.35,BSDXIENS,.04)=$P(BSDXVAL,"|",4) ;COLOR
S BSDXFDA(9002018.35,BSDXIENS,.05)=$P(BSDXVAL,"|",5) ;RED
S BSDXFDA(9002018.35,BSDXIENS,.06)=$P(BSDXVAL,"|",6) ;GREEN
S BSDXFDA(9002018.35,BSDXIENS,.07)=$P(BSDXVAL,"|",7) ;BLUE
S BSDXFDA(9002018.35,BSDXIENS,.08)=BSDXPA ;PREVENT ACCESS
K BSDXMSG
I BSDX="ADD" D
. K BSDXIEN
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
. S BSDXIEN=+$G(BSDXIEN(1))
E D
. D FILE^DIE("","BSDXFDA","BSDXMSG")
S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(30)_$C(31)
Q
;
ERR(BSDXERID,ERRTXT) ;Error processing
S:'+$G(BSDXI) BSDXI=999999
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
ERROR ;
D ^%ZTER
I '+$G(BSDXI) N BSDXI S BSDXI=999999
S BSDXI=BSDXI+1
D ERR(0,"BSDX14 M Error: <"_$G(%ZTERROR)_">")
Q
BSDX14 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
ACCTYPD(BSDXY,BSDXVAL) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("ACCTYP^BSDX14(.BSDXY,BSDXVAL)")
+4 QUIT
+5 ;
ACCTYP(BSDXY,BSDXVAL) ;EP
+1 ;Called by BSDX ADD/EDIT ACCESS TYPE
+2 ;Add/Edit ACCESS TYPE entry
+3 ;BSDXVAL is IEN|NAME|INACTIVE|COLOR|RED|GREEN|BLUE|PREVENT_ACCESS
+4 ;If IEN=0 Then this is a new ACCTYPE
+5 ;Test Line:
+6 ;D ACCTYP^BSDX14(.RES,"0|ORAL HYGIENE|false|Red")
+7 ;
+8 SET X="ERROR^BSDX14"
SET @^%ZOSF("TRAP")
+9 NEW BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXNAM
+10 SET BSDXY="^BSDXTMP("_$JOB_")"
+11 SET ^BSDXTMP($JOB,0)="I00020ACCESSTYPEID^T00030ERRORTEXT"_$CHAR(30)
+12 IF BSDXVAL=""
DO ERR(0,"BSDX14: Invalid null input Parameter")
QUIT
+13 SET BSDXIEN=$PIECE(BSDXVAL,"|")
+14 IF +BSDXIEN
Begin DoDot:1
+15 SET BSDX="EDIT"
+16 SET BSDXIENS=BSDXIEN_","
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 SET BSDX="ADD"
+19 SET BSDXIENS="+1,"
End DoDot:1
+20 ;
+21 SET BSDXNAM=$PIECE(BSDXVAL,"|",2)
+22 IF BSDXNAM=""
DO ERR(0,"BSDX14: Invalid null Access Type name.")
QUIT
+23 ;
+24 ;Prevent adding entry with duplicate name
+25 IF $DATA(^BSDXTYPE("B",BSDXNAM))
IF $ORDER(^BSDXTYPE("B",BSDXNAM,0))'=BSDXIEN
Begin DoDot:1
+26 DO ERR(0,"BSDX14: Cannot have two Access Types with the same name.")
+27 QUIT
End DoDot:1
QUIT
+28 ;setup inactive flag
+29 SET BSDXINA=$PIECE(BSDXVAL,"|",3)
+30 SET BSDXINA=$SELECT(BSDXINA="YES":1,1:0)
+31 ;setup prevent access flag
+32 SET BSDXPA=$PIECE(BSDXVAL,"|",8)
+33 SET BSDXPA=$SELECT(BSDXPA="YES":1,1:0)
+34 ;
+35 ;NAME
SET BSDXFDA(9002018.35,BSDXIENS,.01)=$PIECE(BSDXVAL,"|",2)
+36 ;INACTIVE
SET BSDXFDA(9002018.35,BSDXIENS,.02)=BSDXINA
+37 ;COLOR
SET BSDXFDA(9002018.35,BSDXIENS,.04)=$PIECE(BSDXVAL,"|",4)
+38 ;RED
SET BSDXFDA(9002018.35,BSDXIENS,.05)=$PIECE(BSDXVAL,"|",5)
+39 ;GREEN
SET BSDXFDA(9002018.35,BSDXIENS,.06)=$PIECE(BSDXVAL,"|",6)
+40 ;BLUE
SET BSDXFDA(9002018.35,BSDXIENS,.07)=$PIECE(BSDXVAL,"|",7)
+41 ;PREVENT ACCESS
SET BSDXFDA(9002018.35,BSDXIENS,.08)=BSDXPA
+42 KILL BSDXMSG
+43 IF BSDX="ADD"
Begin DoDot:1
+44 KILL BSDXIEN
+45 DO UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
+46 SET BSDXIEN=+$GET(BSDXIEN(1))
End DoDot:1
+47 IF '$TEST
Begin DoDot:1
+48 DO FILE^DIE("","BSDXFDA","BSDXMSG")
End DoDot:1
+49 SET ^BSDXTMP($JOB,1)=$GET(BSDXIEN)_"^-1"_$CHAR(30)_$CHAR(31)
+50 QUIT
+51 ;
ERR(BSDXERID,ERRTXT) ;Error processing
+1 IF '+$GET(BSDXI)
SET BSDXI=999999
+2 SET BSDXI=BSDXI+1
+3 SET ^BSDXTMP($JOB,BSDXI)=BSDXERID_"^"_ERRTXT_$CHAR(30)
+4 SET BSDXI=BSDXI+1
+5 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+6 QUIT
+7 ;
ERROR ;
+1 DO ^%ZTER
+2 IF '+$GET(BSDXI)
NEW BSDXI
SET BSDXI=999999
+3 SET BSDXI=BSDXI+1
+4 DO ERR(0,"BSDX14 M Error: <"_$GET(%ZTERROR)_">")
+5 QUIT
