BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ;;1.5;BSDX;;Jan 25, 2011 ; ; 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