- 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
