PSGWI015.m

PSGWI015 ; ; 04-JAN-1994

 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

 Q:'DIFQ(58.17)  F I=1:2 S X=$T(Q+I) Q:X=""  S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) X NO E  S @X=Y

Q Q

 ;;^DIC(58.17,0,"GL")

 ;;=^PSI(58.17,

 ;;^DIC("B","AOU ITEM LOCATION",58.17)

 ;;=

 ;;^DIC(58.17,"%",0)

 ;;=^1.005^1^1

 ;;^DIC(58.17,"%",1,0)

 ;;=PSGW

 ;;^DIC(58.17,"%","B","PSGW",1)

 ;;=

 ;;^DIC(58.17,"%D",0)

 ;;=^^2^2^2900213^^^^

 ;;^DIC(58.17,"%D",1,0)

 ;;=Expansions of the codes used to indicate storage location of item

 ;;^DIC(58.17,"%D",2,0)

 ;;=in the area of use.

 ;;^DD(58.17,0)

 ;;=FIELD^^.5^2

 ;;^DD(58.17,0,"ID",.5)

 ;;=W:$D(^("0")) "   ",$P(^("0"),U,3)

 ;;^DD(58.17,0,"IX","B",58.17,.01)

 ;;=

 ;;^DD(58.17,0,"NM","AOU ITEM LOCATION")

 ;;=

 ;;^DD(58.17,.01,0)

 ;;=ITEM ADDRESS CODE^RF^^0;1^K:$L(X)>3!($L(X)<1)!'(X?1AN.AN) X

 ;;^DD(58.17,.01,1,0)

 ;;=^.1

 ;;^DD(58.17,.01,1,1,0)

 ;;=58.17^B

 ;;^DD(58.17,.01,1,1,1)

 ;;=S ^PSI(58.17,"B",$E(X,1,30),DA)=""

 ;;^DD(58.17,.01,1,1,2)

 ;;=K ^PSI(58.17,"B",$E(X,1,30),DA)

 ;;^DD(58.17,.01,3)

 ;;=Answer must be 1-3 characters in length

 ;;^DD(58.17,.01,21,0)

 ;;=^^3^3^2871008^^^^

 ;;^DD(58.17,.01,21,1,0)

 ;;=This contains a code that represents a portion of an item's location 

 ;;^DD(58.17,.01,21,2,0)

 ;;=address in an Area of Use.  This code is associated with an expansion 

 ;;^DD(58.17,.01,21,3,0)

 ;;=for clarity.

 ;;^DD(58.17,.01,"DT")

 ;;=2840614

 ;;^DD(58.17,.5,0)

 ;;=CODE EXPANSION^F^^0;3^K:$L(X)>30!($L(X)<1) X

 ;;^DD(58.17,.5,3)

 ;;=Enter 1-30 characters

 ;;^DD(58.17,.5,21,0)

 ;;=^^2^2^2871008^^

 ;;^DD(58.17,.5,21,1,0)

 ;;=This text is used to clarify the meaning of the associated code.  Its

 ;;^DD(58.17,.5,21,2,0)

 ;;=primary purpose is for report information.

 ;;^DD(58.17,.5,"DT")

 ;;=2840614

PSGWI015  ; ; 04-JAN-1994

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

 +2        IF 'DIFQ(58.17)

               QUIT 

           FOR I=1:2

               SET X=$TEXT(Q+I)

               IF X=""

                   QUIT 

               SET Y=$EXTRACT($TEXT(Q+I+1),4,999)

               SET X=$EXTRACT(X,4,999)

               IF $ASCII(Y)=126

                   SET I=I+1

                   SET Y=$EXTRACT(Y,2,999)_$EXTRACT($TEXT(Q+I+1),5,99)

               IF $ASCII(Y)=61

                   SET Y=$EXTRACT(Y,2,999)

               XECUTE NO

              IF '$TEST

                   SET @X=Y

Q          QUIT 

 +1       ;;^DIC(58.17,0,"GL")

 +2       ;;=^PSI(58.17,

 +3       ;;^DIC("B","AOU ITEM LOCATION",58.17)

 +4       ;;=

 +5       ;;^DIC(58.17,"%",0)

 +6       ;;=^1.005^1^1

 +7       ;;^DIC(58.17,"%",1,0)

 +8       ;;=PSGW

 +9       ;;^DIC(58.17,"%","B","PSGW",1)

 +10      ;;=

 +11      ;;^DIC(58.17,"%D",0)

 +12      ;;=^^2^2^2900213^^^^

 +13      ;;^DIC(58.17,"%D",1,0)

 +14      ;;=Expansions of the codes used to indicate storage location of item

 +15      ;;^DIC(58.17,"%D",2,0)

 +16      ;;=in the area of use.

 +17      ;;^DD(58.17,0)

 +18      ;;=FIELD^^.5^2

 +19      ;;^DD(58.17,0,"ID",.5)

 +20      ;;=W:$D(^("0")) "   ",$P(^("0"),U,3)

 +21      ;;^DD(58.17,0,"IX","B",58.17,.01)

 +22      ;;=

 +23      ;;^DD(58.17,0,"NM","AOU ITEM LOCATION")

 +24      ;;=

 +25      ;;^DD(58.17,.01,0)

 +26      ;;=ITEM ADDRESS CODE^RF^^0;1^K:$L(X)>3!($L(X)<1)!'(X?1AN.AN) X

 +27      ;;^DD(58.17,.01,1,0)

 +28      ;;=^.1

 +29      ;;^DD(58.17,.01,1,1,0)

 +30      ;;=58.17^B

 +31      ;;^DD(58.17,.01,1,1,1)

 +32      ;;=S ^PSI(58.17,"B",$E(X,1,30),DA)=""

 +33      ;;^DD(58.17,.01,1,1,2)

 +34      ;;=K ^PSI(58.17,"B",$E(X,1,30),DA)

 +35      ;;^DD(58.17,.01,3)

 +36      ;;=Answer must be 1-3 characters in length

 +37      ;;^DD(58.17,.01,21,0)

 +38      ;;=^^3^3^2871008^^^^

 +39      ;;^DD(58.17,.01,21,1,0)

 +40      ;;=This contains a code that represents a portion of an item's location 

 +41      ;;^DD(58.17,.01,21,2,0)

 +42      ;;=address in an Area of Use.  This code is associated with an expansion 

 +43      ;;^DD(58.17,.01,21,3,0)

 +44      ;;=for clarity.

 +45      ;;^DD(58.17,.01,"DT")

 +46      ;;=2840614

 +47      ;;^DD(58.17,.5,0)

 +48      ;;=CODE EXPANSION^F^^0;3^K:$L(X)>30!($L(X)<1) X

 +49      ;;^DD(58.17,.5,3)

 +50      ;;=Enter 1-30 characters

 +51      ;;^DD(58.17,.5,21,0)

 +52      ;;=^^2^2^2871008^^

 +53      ;;^DD(58.17,.5,21,1,0)

 +54      ;;=This text is used to clarify the meaning of the associated code.  Its

 +55      ;;^DD(58.17,.5,21,2,0)

 +56      ;;=primary purpose is for report information.

 +57      ;;^DD(58.17,.5,"DT")

 +58      ;;=2840614