PSGWI029 ; ; 04-JAN-1994
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
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
;;^UTILITY(U,$J,"DIBT",23,0)
;;=PSGW ITEM LOC^2840915^^58.17^^^^
;;^UTILITY(U,$J,"DIBT",23,2,1)
;;=58.17^.01^ITEM ADDRESS CODE^^
;;^UTILITY(U,$J,"DIBT",23,2,1,"IX")
;;=^PSI(58.17,"B",^PSI(58.17,^2
;;^UTILITY(U,$J,"DIBT",23,2,2)
;;=58.17^^("A"="A")^'@"@B^;L1
;;^UTILITY(U,$J,"DIBT",23,2,2,"CM")
;;=S X="A"="A" I D0>0 S X(2)=X
;;^UTILITY(U,$J,"DIBT",23,2,2,"F")
;;=0
;;^UTILITY(U,$J,"DIBT",23,2,2,"T")
;;=1
;;^UTILITY(U,$J,"DIBT",23,"DIPT")
;;=PSGW ITEM LOC
;;^UTILITY(U,$J,"DIBT",25,0)
;;=PSGW INV TYPE^2840915^^58.16^^^^
;;^UTILITY(U,$J,"DIBT",25,2,1)
;;=58.16^.01^NAME^^
;;^UTILITY(U,$J,"DIBT",25,2,1,"IX")
;;=^PSI(58.16,"B",^PSI(58.16,^2
;;^UTILITY(U,$J,"DIBT",25,2,2)
;;=58.16^^("A"="A")^'"@B^;"";L1
;;^UTILITY(U,$J,"DIBT",25,2,2,"CM")
;;=S X="A"="A" I D0>0 S X(2)=X
;;^UTILITY(U,$J,"DIBT",25,2,2,"F")
;;=0
;;^UTILITY(U,$J,"DIBT",25,2,2,"T")
;;=1
;;^UTILITY(U,$J,"DIBT",46,0)
;;=PSGW SHOW AREA OF USE^2890627.1455^^58.1^^^^
;;^UTILITY(U,$J,"DIBT",46,2,1)
;;=58.1^^INPATIENT SITE^#"4^
;;^UTILITY(U,$J,"DIBT",46,2,1,"CM")
;;=S Y(1)=$S($D(^PSI(58.1,D0,"SITE")):^("SITE"),1:"") S X=$S('$D(^PS(59.4,+$P(Y(1),U,1),0)):"",1:$P(^(0),U,1)) I D0>0 S X(1)=X
;;^UTILITY(U,$J,"DIBT",46,2,2)
;;=58.1^.01^AREA OF USE (AOU)^^
;;^UTILITY(U,$J,"DIBT",46,2,2,"IX")
;;=^PSI(58.1,"B",^PSI(58.1,^2
;;^UTILITY(U,$J,"DIBT",49,0)
;;=PSGW PERCENTAGE^2880212^^58.1^^^^
;;^UTILITY(U,$J,"DIBT",49,2,1)
;;=58.12^5^PERCENTAGE OF STOCK ON HAND^@^
;;^UTILITY(U,$J,"DIBT",49,2,1,58.1)
;;=1
;;^UTILITY(U,$J,"DIBT",49,2,1,58.11)
;;=1
;;^UTILITY(U,$J,"DIBT",49,2,1,"ASK")
;;=
;;^UTILITY(U,$J,"DIBT",49,2,1,"F")
;;=59.99999
;;^UTILITY(U,$J,"DIBT",49,2,1,"T")
;;=100
;;^UTILITY(U,$J,"DIBT",49,2,2)
;;=58.11^^ITEM^@".01^
;;^UTILITY(U,$J,"DIBT",49,2,2,58.1)
;;=1
;;^UTILITY(U,$J,"DIBT",49,2,2,"CM")
;;=S Y(1)=$S($D(^PSI(58.1,D0,1,D1,0)):^(0),1:"") S X=$S('$D(^PSDRUG(+$P(Y(1),U,1),0)):"",1:$P(^(0),U,1)) I D1>0 S X(2)=X
;;^UTILITY(U,$J,"DIBT",49,2,3)
;;=58.12^^DATE(DATE/TIME FOR INVENTORY)^@"^^^D
;;^UTILITY(U,$J,"DIBT",49,2,3,58.1)
;;=1
;;^UTILITY(U,$J,"DIBT",49,2,3,58.11)
;;=1
;;^UTILITY(U,$J,"DIBT",49,2,3,"ASK")
;;=
;;^UTILITY(U,$J,"DIBT",49,2,3,"CM")
;;=S Y(1)=$S($D(^PSI(58.1,D0,1,D1,1,D2,0)):^(0),1:"") S X=$S('$D(^PSI(58.19,+$P(Y(1),U,1),0)):"",1:$P(^(0),U,1)),X=$P(X,".",1) I D2>0 S X(3)=X
;;^UTILITY(U,$J,"DIBT",49,2,3,"F")
;;=2870700.99999
;;^UTILITY(U,$J,"DIBT",49,2,3,"T")
;;=z
;;^UTILITY(U,$J,"DIE",22,0)
;;=PSGW WARD INVENTORY^2880502^^58.2^^^^
;;^UTILITY(U,$J,"DIE",22,"DIAB",1,2,58.22,0)
;;=ALL
;;^UTILITY(U,$J,"DIE",22,"DR",1,58.2)
;;=.01;2;S PSGWSK=0,PSGWSKP=0;@1;S PSGWSK=$O(^PSI(58.2,DA,1,"D",PSGWSK));I 'PSGWSK S PSGWS=$S(PSGWSKP>0:(PSGWSKP+100),1:100),Y="@2";S PSGWSKP=PSGWSK;S Y="@1";@2;1;K PSGWS,PSGWSK,PSGWSKP,X,Y,%X,%Y,W;
;;^UTILITY(U,$J,"DIE",22,"DR",2,58.21)
;;=.01;1;I $P(^PSI(58.2,D0,1,D1,0),"^",2)'="" S Y="@3";2///^S X=PSGWS;S PSGWS=PSGWS+100;@3;
;;^UTILITY(U,$J,"DIE",22,"DR",3,58.22)
;;=.01
;;^UTILITY(U,$J,"DIE",28,0)
;;=PSGW AREA OF USE EDIT^2930527.1056^^58.1^^^^
;;^UTILITY(U,$J,"DIE",28,"DR",1,58.1)
;;=.01;4;.5;.75;5;6;S:X'=1 Y=2;7;2;
;;^UTILITY(U,$J,"DIE",28,"DR",2,58.14)
;;=.01;1;2;
;;^UTILITY(U,$J,"DIE",28,"DR",3,58.27)
;;=.01;1;
;;^UTILITY(U,$J,"DIE",34,0)
;;=PSGW ENTER/EDIT AMIS DATA^2880502^^50^^^^
;;^UTILITY(U,$J,"DIE",34,"DR",1,50)
;;=12;13;15;301;302;K %X,%Y;
;;^UTILITY(U,$J,"DIE",114,0)
;;=PSGW INACTIVATE ITEM^2890330^^58.1^^^^
;;^UTILITY(U,$J,"DIE",114,"DR",1,58.1)
;;=1;K %DT,%X,C,DIG,DIH,DIU;K DIV,K,PSGWDRUG,W,X,Y;
;;^UTILITY(U,$J,"DIE",114,"DR",2,58.11)
;;=30;S:X="" Y="@1";31;S:X'="O" Y="@1";33;@1;
;;^UTILITY(U,$J,"DIPT",54,0)
;;=PSGW ITEM LOC^2840915^^58.17^^^^
;;^UTILITY(U,$J,"DIPT",54,"F",1)
;;=W "";"";Z;"W """~.01;C7;"ITEM ADDR CODE"~.5~
;;^UTILITY(U,$J,"DIPT",54,"H")
;;=AREA OF USE ITEM LOCATION EXPANSIONS
;;^UTILITY(U,$J,"DIPT",55,0)
;;=PSGW INV TYPE^2840915^^58.16^^^^
;;^UTILITY(U,$J,"DIPT",55,"F",1)
;;=W "";"";Z;"W """~.01;C6;S~1,.01~
;;^UTILITY(U,$J,"DIPT",55,"H")
;;=AREA OF USE INVENTORY TYPES
;;^UTILITY(U,$J,"DIPT",56,0)
;;=PSGW PERCENTAGE^2880211^^58.1^^^^
PSGWI029 ; ; 04-JAN-1994
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 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 ;;^UTILITY(U,$J,"DIBT",23,0)
+2 ;;=PSGW ITEM LOC^2840915^^58.17^^^^
+3 ;;^UTILITY(U,$J,"DIBT",23,2,1)
+4 ;;=58.17^.01^ITEM ADDRESS CODE^^
+5 ;;^UTILITY(U,$J,"DIBT",23,2,1,"IX")
+6 ;;=^PSI(58.17,"B",^PSI(58.17,^2
+7 ;;^UTILITY(U,$J,"DIBT",23,2,2)
+8 ;;=58.17^^("A"="A")^'@"@B^;L1
+9 ;;^UTILITY(U,$J,"DIBT",23,2,2,"CM")
+10 ;;=S X="A"="A" I D0>0 S X(2)=X
+11 ;;^UTILITY(U,$J,"DIBT",23,2,2,"F")
+12 ;;=0
+13 ;;^UTILITY(U,$J,"DIBT",23,2,2,"T")
+14 ;;=1
+15 ;;^UTILITY(U,$J,"DIBT",23,"DIPT")
+16 ;;=PSGW ITEM LOC
+17 ;;^UTILITY(U,$J,"DIBT",25,0)
+18 ;;=PSGW INV TYPE^2840915^^58.16^^^^
+19 ;;^UTILITY(U,$J,"DIBT",25,2,1)
+20 ;;=58.16^.01^NAME^^
+21 ;;^UTILITY(U,$J,"DIBT",25,2,1,"IX")
+22 ;;=^PSI(58.16,"B",^PSI(58.16,^2
+23 ;;^UTILITY(U,$J,"DIBT",25,2,2)
+24 ;;=58.16^^("A"="A")^'"@B^;"";L1
+25 ;;^UTILITY(U,$J,"DIBT",25,2,2,"CM")
+26 ;;=S X="A"="A" I D0>0 S X(2)=X
+27 ;;^UTILITY(U,$J,"DIBT",25,2,2,"F")
+28 ;;=0
+29 ;;^UTILITY(U,$J,"DIBT",25,2,2,"T")
+30 ;;=1
+31 ;;^UTILITY(U,$J,"DIBT",46,0)
+32 ;;=PSGW SHOW AREA OF USE^2890627.1455^^58.1^^^^
+33 ;;^UTILITY(U,$J,"DIBT",46,2,1)
+34 ;;=58.1^^INPATIENT SITE^#"4^
+35 ;;^UTILITY(U,$J,"DIBT",46,2,1,"CM")
+36 ;;=S Y(1)=$S($D(^PSI(58.1,D0,"SITE")):^("SITE"),1:"") S X=$S('$D(^PS(59.4,+$P(Y(1),U,1),0)):"",1:$P(^(0),U,1)) I D0>0 S X(1)=X
+37 ;;^UTILITY(U,$J,"DIBT",46,2,2)
+38 ;;=58.1^.01^AREA OF USE (AOU)^^
+39 ;;^UTILITY(U,$J,"DIBT",46,2,2,"IX")
+40 ;;=^PSI(58.1,"B",^PSI(58.1,^2
+41 ;;^UTILITY(U,$J,"DIBT",49,0)
+42 ;;=PSGW PERCENTAGE^2880212^^58.1^^^^
+43 ;;^UTILITY(U,$J,"DIBT",49,2,1)
+44 ;;=58.12^5^PERCENTAGE OF STOCK ON HAND^@^
+45 ;;^UTILITY(U,$J,"DIBT",49,2,1,58.1)
+46 ;;=1
+47 ;;^UTILITY(U,$J,"DIBT",49,2,1,58.11)
+48 ;;=1
+49 ;;^UTILITY(U,$J,"DIBT",49,2,1,"ASK")
+50 ;;=
+51 ;;^UTILITY(U,$J,"DIBT",49,2,1,"F")
+52 ;;=59.99999
+53 ;;^UTILITY(U,$J,"DIBT",49,2,1,"T")
+54 ;;=100
+55 ;;^UTILITY(U,$J,"DIBT",49,2,2)
+56 ;;=58.11^^ITEM^@".01^
+57 ;;^UTILITY(U,$J,"DIBT",49,2,2,58.1)
+58 ;;=1
+59 ;;^UTILITY(U,$J,"DIBT",49,2,2,"CM")
+60 ;;=S Y(1)=$S($D(^PSI(58.1,D0,1,D1,0)):^(0),1:"") S X=$S('$D(^PSDRUG(+$P(Y(1),U,1),0)):"",1:$P(^(0),U,1)) I D1>0 S X(2)=X
+61 ;;^UTILITY(U,$J,"DIBT",49,2,3)
+62 ;;=58.12^^DATE(DATE/TIME FOR INVENTORY)^@"^^^D
+63 ;;^UTILITY(U,$J,"DIBT",49,2,3,58.1)
+64 ;;=1
+65 ;;^UTILITY(U,$J,"DIBT",49,2,3,58.11)
+66 ;;=1
+67 ;;^UTILITY(U,$J,"DIBT",49,2,3,"ASK")
+68 ;;=
+69 ;;^UTILITY(U,$J,"DIBT",49,2,3,"CM")
+70 ;;=S Y(1)=$S($D(^PSI(58.1,D0,1,D1,1,D2,0)):^(0),1:"") S X=$S('$D(^PSI(58.19,+$P(Y(1),U,1),0)):"",1:$P(^(0),U,1)),X=$P(X,".",1) I D2>0 S X(3)=X
+71 ;;^UTILITY(U,$J,"DIBT",49,2,3,"F")
+72 ;;=2870700.99999
+73 ;;^UTILITY(U,$J,"DIBT",49,2,3,"T")
+74 ;;=z
+75 ;;^UTILITY(U,$J,"DIE",22,0)
+76 ;;=PSGW WARD INVENTORY^2880502^^58.2^^^^
+77 ;;^UTILITY(U,$J,"DIE",22,"DIAB",1,2,58.22,0)
+78 ;;=ALL
+79 ;;^UTILITY(U,$J,"DIE",22,"DR",1,58.2)
+80 ;;=.01;2;S PSGWSK=0,PSGWSKP=0;@1;S PSGWSK=$O(^PSI(58.2,DA,1,"D",PSGWSK));I 'PSGWSK S PSGWS=$S(PSGWSKP>0:(PSGWSKP+100),1:100),Y="@2";S PSGWSKP=PSGWSK;S Y="@1";@2;1;K PSGWS,PSGWSK,PSGWSKP,X,Y,%X,%Y,W;
+81 ;;^UTILITY(U,$J,"DIE",22,"DR",2,58.21)
+82 ;;=.01;1;I $P(^PSI(58.2,D0,1,D1,0),"^",2)'="" S Y="@3";2///^S X=PSGWS;S PSGWS=PSGWS+100;@3;
+83 ;;^UTILITY(U,$J,"DIE",22,"DR",3,58.22)
+84 ;;=.01
+85 ;;^UTILITY(U,$J,"DIE",28,0)
+86 ;;=PSGW AREA OF USE EDIT^2930527.1056^^58.1^^^^
+87 ;;^UTILITY(U,$J,"DIE",28,"DR",1,58.1)
+88 ;;=.01;4;.5;.75;5;6;S:X'=1 Y=2;7;2;
+89 ;;^UTILITY(U,$J,"DIE",28,"DR",2,58.14)
+90 ;;=.01;1;2;
+91 ;;^UTILITY(U,$J,"DIE",28,"DR",3,58.27)
+92 ;;=.01;1;
+93 ;;^UTILITY(U,$J,"DIE",34,0)
+94 ;;=PSGW ENTER/EDIT AMIS DATA^2880502^^50^^^^
+95 ;;^UTILITY(U,$J,"DIE",34,"DR",1,50)
+96 ;;=12;13;15;301;302;K %X,%Y;
+97 ;;^UTILITY(U,$J,"DIE",114,0)
+98 ;;=PSGW INACTIVATE ITEM^2890330^^58.1^^^^
+99 ;;^UTILITY(U,$J,"DIE",114,"DR",1,58.1)
+100 ;;=1;K %DT,%X,C,DIG,DIH,DIU;K DIV,K,PSGWDRUG,W,X,Y;
+101 ;;^UTILITY(U,$J,"DIE",114,"DR",2,58.11)
+102 ;;=30;S:X="" Y="@1";31;S:X'="O" Y="@1";33;@1;
+103 ;;^UTILITY(U,$J,"DIPT",54,0)
+104 ;;=PSGW ITEM LOC^2840915^^58.17^^^^
+105 ;;^UTILITY(U,$J,"DIPT",54,"F",1)
+106 ;;=W "";"";Z;"W """~.01;C7;"ITEM ADDR CODE"~.5~
+107 ;;^UTILITY(U,$J,"DIPT",54,"H")
+108 ;;=AREA OF USE ITEM LOCATION EXPANSIONS
+109 ;;^UTILITY(U,$J,"DIPT",55,0)
+110 ;;=PSGW INV TYPE^2840915^^58.16^^^^
+111 ;;^UTILITY(U,$J,"DIPT",55,"F",1)
+112 ;;=W "";"";Z;"W """~.01;C6;S~1,.01~
+113 ;;^UTILITY(U,$J,"DIPT",55,"H")
+114 ;;=AREA OF USE INVENTORY TYPES
+115 ;;^UTILITY(U,$J,"DIPT",56,0)
+116 ;;=PSGW PERCENTAGE^2880211^^58.1^^^^
