VIAAPAR ;ALB/CR - RTLS Set Par Levels in GIP ;4/20/16 10:10 pm
;;1.0;RTLS;**4**;April 22, 2013;Build 21
;
Q
; Access to file #445 covered by IA #5923
; Get unique handle ID string for ^XTMP covered by IA #4770
;
;-- get par levels (stock levels) from WaveMark and set them in a GIP IP
;
SETPAR(RETSTA,IPNAME,ITEM,PAR1,PAR2,PAR3,PAR4,PAR5) ;
; RPC: [VIAA SET PAR LEVELS IN GIP]
;
; -- input parameters:
; retsta - return array that carries the call result, required
; inventory point name (IP) - required
; item master # - required
; par levels - not all required and any can be zero or null but
; not less than zero.
; -- output result:
; stored in ^XTMP("VIAAPAR",$J,0) and passed forward via RETSTA;
; contains a short message to indicate success. For a failure,
; the following format is used:
; "-###^"_failure_message, where '###' is a 3-digit http status
; code.
;
N A,FDA,ERR,VIAA,IPIEN,PAR9,PAR10,PAR11,PAR23,TIMDATE,X,Y
; clean up ^TMP of old data and ^XTMP if found
S A="" F S A=$O(^TMP(A)) Q:A="" I $E(A,1,7)["VIAAPAR" K ^TMP(A),^XTMP(A)
;
S VIAA=$$HANDLE^XUSRB4("VIAAPAR") ; get handle, prepare for entry in ^XTMP
S $P(^XTMP(VIAA,0),U,3)="Par Levels Set up for GIP"
S X=DT D NOW^%DTC,YX^%DTC S TIMDATE=Y ; current date/time
S ^TMP(VIAA,"Received_Data_From_WaveMark",TIMDATE)=IPNAME_U_ITEM_U_PAR1_U_PAR2_U_PAR3_U_PAR4_U_PAR5
;
I $G(IPNAME)="" S ^XTMP(VIAA,$J,0)="-400^Inventory Point name not specified" D EXIT Q
S IPIEN=+$O(^PRCP(445,"B",IPNAME,""))
I 'IPIEN S ^XTMP(VIAA,$J,0)="-404^"_IPNAME_" is an invalid Inventory Point" D EXIT Q
I ITEM=""!(+ITEM=0) S ^XTMP(VIAA,$J,0)="-400^Item Master # not specified" D EXIT Q
I +ITEM'=ITEM S ^XTMP(VIAA,$J,0)="-400^Item Master #"_ITEM_" not found in Inventory Point "_IPNAME D EXIT Q
;
I '$D(^PRCP(445,IPIEN,1,ITEM,0)) S ^XTMP(VIAA,$J,0)="-400^Item Master #"_ITEM_" not found in Inventory Point "_IPNAME D EXIT Q
;
I (PAR1<0)!(PAR2<0)!(PAR3<0)!(PAR4<0)!(PAR5<0) S ^XTMP(VIAA,$J,0)="-400^A par level cannot be negative" D EXIT Q
I (PAR1'?.N)!(PAR2'?.N)!(PAR3'?.N)!(PAR4'?.N)!(PAR5'?.N) S ^XTMP(VIAA,$J,0)="-400^Illegal par level detected - only null, zero, or a number greater than zero are allowed" D EXIT Q
;
;-- update the par levels in GIP: number designates the global piece
; set during the update; translation order: par9=par1, par11=par2, ; par10=par3, par4=par4, par23=par5
;
S PAR9=PAR1,PAR11=PAR2,PAR10=PAR3,PAR23=PAR5
;
S X=DT D NOW^%DTC,YX^%DTC S TIMDATE=Y ; current date/time
L +^PRCP(445,IPIEN,1,ITEM,0):1 I '$T S ^XTMP(VIAA,$J,0)="-423^The resource that is being accessed is locked - cannot complete par levels processing for Item Master #"_ITEM_", on "_TIMDATE D EXIT Q
S FDA(445.01,ITEM_","_IPIEN_",",10.3)=PAR4 ; optional reorder level
S FDA(445.01,ITEM_","_IPIEN_",",9)=PAR9 ; normal stock level
S FDA(445.01,ITEM_","_IPIEN_",",10)=PAR10 ; std reorder level
S FDA(445.01,ITEM_","_IPIEN_",",11)=PAR11 ; emergency stock level
S FDA(445.01,ITEM_","_IPIEN_",",9.5)=PAR23 ; temp stock level
D FILE^DIE("","FDA","ERR")
L -^PRCP(445,IPIEN,1,ITEM,0)
I $D(ERR) S ^XTMP(VIAA,$J,0)="-400^GIP par levels update not filed" D EXIT Q
S ^XTMP(VIAA,$J,0)="1^GIP par levels update completed for IP "_IPNAME_" and Item Master #"_ITEM_" on "_TIMDATE
;
EXIT S RETSTA=$NA(^XTMP(VIAA,$J))
; save whatever we processed and answer sent to the calling app
M ^TMP(VIAA,"Saved_Transaction_Header")=^XTMP(VIAA,0)
M ^TMP(VIAA,"Saved_Transaction_Type: Par Levels Set up")=^XTMP(VIAA,$J)
L -^XTMP(VIAA) ; release lock for $$HANDLE^XUSRB4 call
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIAAPAR 3662 printed Dec 13, 2024@02:33:16 Page 2
VIAAPAR ;ALB/CR - RTLS Set Par Levels in GIP ;4/20/16 10:10 pm
+1 ;;1.0;RTLS;**4**;April 22, 2013;Build 21
+2 ;
+3 QUIT
+4 ; Access to file #445 covered by IA #5923
+5 ; Get unique handle ID string for ^XTMP covered by IA #4770
+6 ;
+7 ;-- get par levels (stock levels) from WaveMark and set them in a GIP IP
+8 ;
SETPAR(RETSTA,IPNAME,ITEM,PAR1,PAR2,PAR3,PAR4,PAR5) ;
+1 ; RPC: [VIAA SET PAR LEVELS IN GIP]
+2 ;
+3 ; -- input parameters:
+4 ; retsta - return array that carries the call result, required
+5 ; inventory point name (IP) - required
+6 ; item master # - required
+7 ; par levels - not all required and any can be zero or null but
+8 ; not less than zero.
+9 ; -- output result:
+10 ; stored in ^XTMP("VIAAPAR",$J,0) and passed forward via RETSTA;
+11 ; contains a short message to indicate success. For a failure,
+12 ; the following format is used:
+13 ; "-###^"_failure_message, where '###' is a 3-digit http status
+14 ; code.
+15 ;
+16 NEW A,FDA,ERR,VIAA,IPIEN,PAR9,PAR10,PAR11,PAR23,TIMDATE,X,Y
+17 ; clean up ^TMP of old data and ^XTMP if found
+18 SET A=""
FOR
SET A=$ORDER(^TMP(A))
if A=""
QUIT
IF $EXTRACT(A,1,7)["VIAAPAR"
KILL ^TMP(A),^XTMP(A)
+19 ;
+20 ; get handle, prepare for entry in ^XTMP
SET VIAA=$$HANDLE^XUSRB4("VIAAPAR")
+21 SET $PIECE(^XTMP(VIAA,0),U,3)="Par Levels Set up for GIP"
+22 ; current date/time
SET X=DT
DO NOW^%DTC
DO YX^%DTC
SET TIMDATE=Y
+23 SET ^TMP(VIAA,"Received_Data_From_WaveMark",TIMDATE)=IPNAME_U_ITEM_U_PAR1_U_PAR2_U_PAR3_U_PAR4_U_PAR5
+24 ;
+25 IF $GET(IPNAME)=""
SET ^XTMP(VIAA,$JOB,0)="-400^Inventory Point name not specified"
DO EXIT
QUIT
+26 SET IPIEN=+$ORDER(^PRCP(445,"B",IPNAME,""))
+27 IF 'IPIEN
SET ^XTMP(VIAA,$JOB,0)="-404^"_IPNAME_" is an invalid Inventory Point"
DO EXIT
QUIT
+28 IF ITEM=""!(+ITEM=0)
SET ^XTMP(VIAA,$JOB,0)="-400^Item Master # not specified"
DO EXIT
QUIT
+29 IF +ITEM'=ITEM
SET ^XTMP(VIAA,$JOB,0)="-400^Item Master #"_ITEM_" not found in Inventory Point "_IPNAME
DO EXIT
QUIT
+30 ;
+31 IF '$DATA(^PRCP(445,IPIEN,1,ITEM,0))
SET ^XTMP(VIAA,$JOB,0)="-400^Item Master #"_ITEM_" not found in Inventory Point "_IPNAME
DO EXIT
QUIT
+32 ;
+33 IF (PAR1<0)!(PAR2<0)!(PAR3<0)!(PAR4<0)!(PAR5<0)
SET ^XTMP(VIAA,$JOB,0)="-400^A par level cannot be negative"
DO EXIT
QUIT
+34 IF (PAR1'?.N)!(PAR2'?.N)!(PAR3'?.N)!(PAR4'?.N)!(PAR5'?.N)
SET ^XTMP(VIAA,$JOB,0)="-400^Illegal par level detected - only null, zero, or a number greater than zero are allowed"
DO EXIT
QUIT
+35 ;
+36 ;-- update the par levels in GIP: number designates the global piece
+37 ; set during the update; translation order: par9=par1, par11=par2, ; par10=par3, par4=par4, par23=par5
+38 ;
+39 SET PAR9=PAR1
SET PAR11=PAR2
SET PAR10=PAR3
SET PAR23=PAR5
+40 ;
+41 ; current date/time
SET X=DT
DO NOW^%DTC
DO YX^%DTC
SET TIMDATE=Y
+42 LOCK +^PRCP(445,IPIEN,1,ITEM,0):1
IF '$TEST
SET ^XTMP(VIAA,$JOB,0)="-423^The resource that is being accessed is locked - cannot complete par levels processing for Item Master #"_ITEM_", on "_TIMDATE
DO EXIT
QUIT
+43 ; optional reorder level
SET FDA(445.01,ITEM_","_IPIEN_",",10.3)=PAR4
+44 ; normal stock level
SET FDA(445.01,ITEM_","_IPIEN_",",9)=PAR9
+45 ; std reorder level
SET FDA(445.01,ITEM_","_IPIEN_",",10)=PAR10
+46 ; emergency stock level
SET FDA(445.01,ITEM_","_IPIEN_",",11)=PAR11
+47 ; temp stock level
SET FDA(445.01,ITEM_","_IPIEN_",",9.5)=PAR23
+48 DO FILE^DIE("","FDA","ERR")
+49 LOCK -^PRCP(445,IPIEN,1,ITEM,0)
+50 IF $DATA(ERR)
SET ^XTMP(VIAA,$JOB,0)="-400^GIP par levels update not filed"
DO EXIT
QUIT
+51 SET ^XTMP(VIAA,$JOB,0)="1^GIP par levels update completed for IP "_IPNAME_" and Item Master #"_ITEM_" on "_TIMDATE
+52 ;
EXIT SET RETSTA=$NAME(^XTMP(VIAA,$JOB))
+1 ; save whatever we processed and answer sent to the calling app
+2 MERGE ^TMP(VIAA,"Saved_Transaction_Header")=^XTMP(VIAA,0)
+3 MERGE ^TMP(VIAA,"Saved_Transaction_Type: Par Levels Set up")=^XTMP(VIAA,$JOB)
+4 ; release lock for $$HANDLE^XUSRB4 call
LOCK -^XTMP(VIAA)
+5 QUIT
