VIAAPAR.m

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 ---VIAAPAR   3662     printed  Apr 23, 2025@18:47:49                                                                                                                                                                                                     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