BSDX16 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
RSRCD(BSDXY,BSDXVAL) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("RSRC^BSDX16(.BSDXY,BSDXVAL)")
Q
;
RSRC(BSDXY,BSDXVAL) ;EP
;
;Called by BSDX ADD/EDIT RESOURCE
;Add/Edit BSDX RESOURCE entry
;BSDXVAL is sResourceID|sResourceName|sInactive|sHospLocID|TIME_SCALE|LETTER_TEXT|NO_SHOW_LETTER|CANCELLATION_LETTER
;If IEN=0 Then this is a new Resource
;Test Line:
;D RSRC^BSDX16(.RES,"sResourceID|sResourceName|sInactive|sHospLocID")
;
S X="ERROR^BSDX16",@^%ZOSF("TRAP")
N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXINA,BSDXNOTE,BSDXNAM
S BSDXY="^BSDXTMP("_$J_")"
K ^BSDXTMP($J)
S ^BSDXTMP($J,0)="I00020RESOURCEID^T00030ERRORTEXT"_$C(30)
; Changed following from a $G = "" to $D check: $G didn't work since BSDXVAL is an array. MJL 10/18/2006
I BSDXVAL="",$D(BSDXVAL)<2 D ERR(0,"BSDX16: Invalid null input Parameter") Q
;Unpack array at @XWBARY
I BSDXVAL="" D
. N BSDXC S BSDXC=0 F S BSDXC=$O(BSDXVAL(BSDXC)) Q:'BSDXC D
. . S BSDXVAL=BSDXVAL_BSDXVAL(BSDXC)
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)
;Prevent adding entry with duplicate name
I $D(^BSDXRES("B",BSDXNAM)),$O(^BSDXRES("B",BSDXNAM,0))'=BSDXIEN D Q
. D ERR(0,"BSDX16: Cannot have two Resources with the same name.")
. Q
;
S BSDXINA=$P(BSDXVAL,"|",3)
S BSDXINA=$S(BSDXINA="YES":1,1:0)
;
S BSDXFDA(9002018.1,BSDXIENS,.01)=$P(BSDXVAL,"|",2) ;NAME
S BSDXFDA(9002018.1,BSDXIENS,.02)=BSDXINA ;INACTIVE
I +$P(BSDXVAL,"|",5) S BSDXFDA(9002018.1,BSDXIENS,.03)=+$P(BSDXVAL,"|",5) ;TIME SCALE
I +$P(BSDXVAL,"|",4) S BSDXFDA(9002018.1,BSDXIENS,.04)=$P(BSDXVAL,"|",4) ;HOSPITAL LOCATION
K BSDXMSG
I BSDX="ADD" D ;TODO: Check for error
. K BSDXIEN
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
. S BSDXIEN=+$G(BSDXIEN(1))
E D
. D FILE^DIE("","BSDXFDA","BSDXMSG")
;
;LETTER TEXT wp field
S BSDXNOTE=$P(BSDXVAL,"|",6)
;
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
;
I $D(BSDXNOTE(.5)) D
. D WP^DIE(9002018.1,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
;
;NO SHOW LETTER wp fields
K BSDXNOTE
S BSDXNOTE=$P(BSDXVAL,"|",7)
;
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
;
I $D(BSDXNOTE(.5)) D
. D WP^DIE(9002018.1,BSDXIEN_",",1201,"","BSDXNOTE","BSDXMSG")
;
;CANCELLATION LETTER wp field
K BSDXNOTE
S BSDXNOTE=$P(BSDXVAL,"|",8)
;
I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
;
I $D(BSDXNOTE(.5)) D
. D WP^DIE(9002018.1,BSDXIEN_",",1301,"","BSDXNOTE","BSDXMSG")
;
S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^"_$C(30)_$C(31)
Q
;
ERROR ;
D ^%ZTER
I '+$G(BSDXI) N BSDXI S BSDXI=999999
S BSDXI=BSDXI+1
D ERR(0,"BSDX16 M Error: <"_$G(%ZTERROR)_">")
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
BSDX16 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
RSRCD(BSDXY,BSDXVAL) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("RSRC^BSDX16(.BSDXY,BSDXVAL)")
+4 QUIT
+5 ;
RSRC(BSDXY,BSDXVAL) ;EP
+1 ;
+2 ;Called by BSDX ADD/EDIT RESOURCE
+3 ;Add/Edit BSDX RESOURCE entry
+4 ;BSDXVAL is sResourceID|sResourceName|sInactive|sHospLocID|TIME_SCALE|LETTER_TEXT|NO_SHOW_LETTER|CANCELLATION_LETTER
+5 ;If IEN=0 Then this is a new Resource
+6 ;Test Line:
+7 ;D RSRC^BSDX16(.RES,"sResourceID|sResourceName|sInactive|sHospLocID")
+8 ;
+9 SET X="ERROR^BSDX16"
SET @^%ZOSF("TRAP")
+10 NEW BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXINA,BSDXNOTE,BSDXNAM
+11 SET BSDXY="^BSDXTMP("_$JOB_")"
+12 KILL ^BSDXTMP($JOB)
+13 SET ^BSDXTMP($JOB,0)="I00020RESOURCEID^T00030ERRORTEXT"_$CHAR(30)
+14 ; Changed following from a $G = "" to $D check: $G didn't work since BSDXVAL is an array. MJL 10/18/2006
+15 IF BSDXVAL=""
IF $DATA(BSDXVAL)<2
DO ERR(0,"BSDX16: Invalid null input Parameter")
QUIT
+16 ;Unpack array at @XWBARY
+17 IF BSDXVAL=""
Begin DoDot:1
+18 NEW BSDXC
SET BSDXC=0
FOR
SET BSDXC=$ORDER(BSDXVAL(BSDXC))
IF 'BSDXC
QUIT
Begin DoDot:2
+19 SET BSDXVAL=BSDXVAL_BSDXVAL(BSDXC)
End DoDot:2
End DoDot:1
+20 SET BSDXIEN=$PIECE(BSDXVAL,"|")
+21 IF +BSDXIEN
Begin DoDot:1
+22 SET BSDX="EDIT"
+23 SET BSDXIENS=BSDXIEN_","
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 SET BSDX="ADD"
+26 SET BSDXIENS="+1,"
End DoDot:1
+27 ;
+28 SET BSDXNAM=$PIECE(BSDXVAL,"|",2)
+29 ;Prevent adding entry with duplicate name
+30 IF $DATA(^BSDXRES("B",BSDXNAM))
IF $ORDER(^BSDXRES("B",BSDXNAM,0))'=BSDXIEN
Begin DoDot:1
+31 DO ERR(0,"BSDX16: Cannot have two Resources with the same name.")
+32 QUIT
End DoDot:1
QUIT
+33 ;
+34 SET BSDXINA=$PIECE(BSDXVAL,"|",3)
+35 SET BSDXINA=$SELECT(BSDXINA="YES":1,1:0)
+36 ;
+37 ;NAME
SET BSDXFDA(9002018.1,BSDXIENS,.01)=$PIECE(BSDXVAL,"|",2)
+38 ;INACTIVE
SET BSDXFDA(9002018.1,BSDXIENS,.02)=BSDXINA
+39 ;TIME SCALE
IF +$PIECE(BSDXVAL,"|",5)
SET BSDXFDA(9002018.1,BSDXIENS,.03)=+$PIECE(BSDXVAL,"|",5)
+40 ;HOSPITAL LOCATION
IF +$PIECE(BSDXVAL,"|",4)
SET BSDXFDA(9002018.1,BSDXIENS,.04)=$PIECE(BSDXVAL,"|",4)
+41 KILL BSDXMSG
+42 ;TODO: Check for error
IF BSDX="ADD"
Begin DoDot:1
+43 KILL BSDXIEN
+44 DO UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
+45 SET BSDXIEN=+$GET(BSDXIEN(1))
End DoDot:1
+46 IF '$TEST
Begin DoDot:1
+47 DO FILE^DIE("","BSDXFDA","BSDXMSG")
End DoDot:1
+48 ;
+49 ;LETTER TEXT wp field
+50 SET BSDXNOTE=$PIECE(BSDXVAL,"|",6)
+51 ;
+52 IF BSDXNOTE]""
SET BSDXNOTE(.5)=BSDXNOTE
SET BSDXNOTE=""
+53 IF $DATA(BSDXNOTE(0))
SET BSDXNOTE(.5)=BSDXNOTE(0)
KILL BSDXNOTE(0)
+54 ;
+55 IF $DATA(BSDXNOTE(.5))
Begin DoDot:1
+56 DO WP^DIE(9002018.1,BSDXIEN_",",1,"","BSDXNOTE","BSDXMSG")
End DoDot:1
+57 ;
+58 ;NO SHOW LETTER wp fields
+59 KILL BSDXNOTE
+60 SET BSDXNOTE=$PIECE(BSDXVAL,"|",7)
+61 ;
+62 IF BSDXNOTE]""
SET BSDXNOTE(.5)=BSDXNOTE
SET BSDXNOTE=""
+63 IF $DATA(BSDXNOTE(0))
SET BSDXNOTE(.5)=BSDXNOTE(0)
KILL BSDXNOTE(0)
+64 ;
+65 IF $DATA(BSDXNOTE(.5))
Begin DoDot:1
+66 DO WP^DIE(9002018.1,BSDXIEN_",",1201,"","BSDXNOTE","BSDXMSG")
End DoDot:1
+67 ;
+68 ;CANCELLATION LETTER wp field
+69 KILL BSDXNOTE
+70 SET BSDXNOTE=$PIECE(BSDXVAL,"|",8)
+71 ;
+72 IF BSDXNOTE]""
SET BSDXNOTE(.5)=BSDXNOTE
SET BSDXNOTE=""
+73 IF $DATA(BSDXNOTE(0))
SET BSDXNOTE(.5)=BSDXNOTE(0)
KILL BSDXNOTE(0)
+74 ;
+75 IF $DATA(BSDXNOTE(.5))
Begin DoDot:1
+76 DO WP^DIE(9002018.1,BSDXIEN_",",1301,"","BSDXNOTE","BSDXMSG")
End DoDot:1
+77 ;
+78 SET ^BSDXTMP($JOB,1)=$GET(BSDXIEN)_"^"_$CHAR(30)_$CHAR(31)
+79 QUIT
+80 ;
ERROR ;
+1 DO ^%ZTER
+2 IF '+$GET(BSDXI)
NEW BSDXI
SET BSDXI=999999
+3 SET BSDXI=BSDXI+1
+4 DO ERR(0,"BSDX16 M Error: <"_$GET(%ZTERROR)_">")
+5 QUIT
+6 ;
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
