PSGWI021 ; ; 04-JAN-1994
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
Q:'DIFQ(58.3) 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.3,0,"GL")
;;=^PSI(58.3,
;;^DIC("B","PHARMACY BACKORDER",58.3)
;;=
;;^DIC(58.3,"%",0)
;;=^1.005^1^1
;;^DIC(58.3,"%",1,0)
;;=PSGW
;;^DIC(58.3,"%","B","PSGW",1)
;;=
;;^DIC(58.3,"%D",0)
;;=^^3^3^2900920^^^^
;;^DIC(58.3,"%D",1,0)
;;=This file contains information that pertains to backorders, such as the
;;^DIC(58.3,"%D",2,0)
;;=date/time of backorder, the AOU for which the item was backordered,
;;^DIC(58.3,"%D",3,0)
;;=and the quantity backordered.
;;^DD(58.3,0)
;;=FIELD^^1^2
;;^DD(58.3,0,"IX","B",58.3,.01)
;;=
;;^DD(58.3,0,"IX","C",58.31,.01)
;;=
;;^DD(58.3,0,"IX","D",58.32,.01)
;;=
;;^DD(58.3,0,"NM","PHARMACY BACKORDER")
;;=
;;^DD(58.3,.01,0)
;;=ITEM^RP50'^PSDRUG(^0;1^Q
;;^DD(58.3,.01,1,0)
;;=^.1^^-1
;;^DD(58.3,.01,1,1,0)
;;=58.3^B
;;^DD(58.3,.01,1,1,1)
;;=S ^PSI(58.3,"B",$E(X,1,30),DA)=""
;;^DD(58.3,.01,1,1,2)
;;=K ^PSI(58.3,"B",$E(X,1,30),DA)
;;^DD(58.3,.01,3)
;;=
;;^DD(58.3,.01,21,0)
;;=^^1^1^2890906^^^^
;;^DD(58.3,.01,21,1,0)
;;=This contains the name of the item being backordered.
;;^DD(58.3,.01,"DT")
;;=2850305
;;^DD(58.3,1,0)
;;=AOU^58.31PA^^1;0
;;^DD(58.3,1,21,0)
;;=^^1^1^2841220^^
;;^DD(58.3,1,21,1,0)
;;= Enter the name of the Area Of Use for which the item has been backordered
;;^DD(58.31,0)
;;=AOU SUB-FIELD^NL^1^2
;;^DD(58.31,0,"NM","AOU")
;;=
;;^DD(58.31,0,"UP")
;;=58.3
;;^DD(58.31,.01,0)
;;=AOU^MP58.1'X^PSI(58.1,^0;1^S:$D(X) DINUM=X
;;^DD(58.31,.01,1,0)
;;=^.1
;;^DD(58.31,.01,1,1,0)
;;=58.3^C
;;^DD(58.31,.01,1,1,1)
;;=S ^PSI(58.3,"C",$E(X,1,30),DA(1),DA)=""
;;^DD(58.31,.01,1,1,2)
;;=K ^PSI(58.3,"C",$E(X,1,30),DA(1),DA)
;;^DD(58.31,.01,3)
;;=Enter Area of Use for item being backordered.
;;^DD(58.31,.01,21,0)
;;=^^2^2^2890906^^^^
;;^DD(58.31,.01,21,1,0)
;;=This contains the name of the Area of Use for which the item is being
;;^DD(58.31,.01,21,2,0)
;;=backordered.
;;^DD(58.31,.01,"DT")
;;=2900213
;;^DD(58.31,1,0)
;;=DATE/TIME FOR BACKORDER^58.32D^^1;0
;;^DD(58.31,1,21,0)
;;=^^1^1^2841220^^
;;^DD(58.31,1,21,1,0)
;;= Enter the inventory date/time for the item being backordered.
;;^DD(58.32,0)
;;=DATE/TIME FOR BACKORDER SUB-FIELD^NL^4^5
;;^DD(58.32,0,"NM","DATE/TIME FOR BACKORDER")
;;=
;;^DD(58.32,0,"UP")
;;=58.31
;;^DD(58.32,.01,0)
;;=DATE/TIME FOR BACKORDER^D^^0;1^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X
;;^DD(58.32,.01,1,0)
;;=^.1
;;^DD(58.32,.01,1,1,0)
;;=58.3^D
;;^DD(58.32,.01,1,1,1)
;;=S ^PSI(58.3,"D",$E(X,1,30),DA(2),DA(1),DA)=""
;;^DD(58.32,.01,1,1,2)
;;=K ^PSI(58.3,"D",$E(X,1,30),DA(2),DA(1),DA)
;;^DD(58.32,.01,3)
;;=Enter DATE/TIME for this backorder.
;;^DD(58.32,.01,21,0)
;;=^^1^1^2881129^^^^
;;^DD(58.32,.01,21,1,0)
;;=This contains the backorder date/time for the item being backordered.
;;^DD(58.32,.01,"DT")
;;=2881129
;;^DD(58.32,1,0)
;;=CURRENT BACKORDER^NJ6,0^^0;2^K:+X'=X!(X>999999)!(X<0)!(X?.E1"."1N.N) X
;;^DD(58.32,1,1,0)
;;=^.1
;;^DD(58.32,1,1,1,0)
;;=^^TRIGGER^58.32^2
;;^DD(58.32,1,1,1,1)
;;=X ^DD(58.32,1,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^PSI(58.3,D0,1,D1,1,D2,0)):^(0),1:"") S X=$P(Y(1),U,3) S DIU=X K Y S X=DIV S X=DIV X ^DD(58.32,1,1,1,1.4)
;;^DD(58.32,1,1,1,1.3)
;;=K DIV S DIV=X,D0=DA(2),DIV(0)=D0,D1=DA(1),DIV(1)=D1,D2=DA,DIV(2)=D2 S Y(0)=X S Y(1)=$S($D(^PSI(58.3,D0,1,D1,1,D2,0)):^(0),1:"") S X=$P(Y(1),U,3)=""
;;^DD(58.32,1,1,1,1.4)
;;=S DIH=$S($D(^PSI(58.3,DIV(0),1,DIV(1),1,DIV(2),0)):^(0),1:""),DIV=X X "F %=0:0 Q:$L($P(DIH,U,2,99)) S DIH=DIH_U" S %=$P(DIH,U,4,999),DIU=$P(DIH,U,3),^(0)=$P(DIH,U,1,2)_U_DIV_$S(%]"":U_%,1:""),DIH=58.32,DIG=2 D ^DICR:$N(^DD(DIH,DIG,1,0))>0
;;^DD(58.32,1,1,1,2)
;;=Q
;;^DD(58.32,1,1,1,"%D",0)
;;=^^2^2^2930827^
;;^DD(58.32,1,1,1,"%D",1,0)
;;=This cross-reference sets the field ORIGINAL BACKORDER (58.32,2). This
;;^DD(58.32,1,1,1,"%D",2,0)
;;=trigger is only executed when a backorder is first entered.
;;^DD(58.32,1,1,1,"CREATE CONDITION")
;;=ORIGINAL BACKORDER=""
;;^DD(58.32,1,1,1,"CREATE VALUE")
;;=CURRENT BACKORDER
;;^DD(58.32,1,1,1,"DELETE VALUE")
;;=NO EFFECT
;;^DD(58.32,1,1,1,"FIELD")
;;=ORIGINAL
;;^DD(58.32,1,3)
;;=Type a whole number between 0 and 999999
PSGWI021 ; ; 04-JAN-1994
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 IF 'DIFQ(58.3)
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.3,0,"GL")
+2 ;;=^PSI(58.3,
+3 ;;^DIC("B","PHARMACY BACKORDER",58.3)
+4 ;;=
+5 ;;^DIC(58.3,"%",0)
+6 ;;=^1.005^1^1
+7 ;;^DIC(58.3,"%",1,0)
+8 ;;=PSGW
+9 ;;^DIC(58.3,"%","B","PSGW",1)
+10 ;;=
+11 ;;^DIC(58.3,"%D",0)
+12 ;;=^^3^3^2900920^^^^
+13 ;;^DIC(58.3,"%D",1,0)
+14 ;;=This file contains information that pertains to backorders, such as the
+15 ;;^DIC(58.3,"%D",2,0)
+16 ;;=date/time of backorder, the AOU for which the item was backordered,
+17 ;;^DIC(58.3,"%D",3,0)
+18 ;;=and the quantity backordered.
+19 ;;^DD(58.3,0)
+20 ;;=FIELD^^1^2
+21 ;;^DD(58.3,0,"IX","B",58.3,.01)
+22 ;;=
+23 ;;^DD(58.3,0,"IX","C",58.31,.01)
+24 ;;=
+25 ;;^DD(58.3,0,"IX","D",58.32,.01)
+26 ;;=
+27 ;;^DD(58.3,0,"NM","PHARMACY BACKORDER")
+28 ;;=
+29 ;;^DD(58.3,.01,0)
+30 ;;=ITEM^RP50'^PSDRUG(^0;1^Q
+31 ;;^DD(58.3,.01,1,0)
+32 ;;=^.1^^-1
+33 ;;^DD(58.3,.01,1,1,0)
+34 ;;=58.3^B
+35 ;;^DD(58.3,.01,1,1,1)
+36 ;;=S ^PSI(58.3,"B",$E(X,1,30),DA)=""
+37 ;;^DD(58.3,.01,1,1,2)
+38 ;;=K ^PSI(58.3,"B",$E(X,1,30),DA)
+39 ;;^DD(58.3,.01,3)
+40 ;;=
+41 ;;^DD(58.3,.01,21,0)
+42 ;;=^^1^1^2890906^^^^
+43 ;;^DD(58.3,.01,21,1,0)
+44 ;;=This contains the name of the item being backordered.
+45 ;;^DD(58.3,.01,"DT")
+46 ;;=2850305
+47 ;;^DD(58.3,1,0)
+48 ;;=AOU^58.31PA^^1;0
+49 ;;^DD(58.3,1,21,0)
+50 ;;=^^1^1^2841220^^
+51 ;;^DD(58.3,1,21,1,0)
+52 ;;= Enter the name of the Area Of Use for which the item has been backordered
+53 ;;^DD(58.31,0)
+54 ;;=AOU SUB-FIELD^NL^1^2
+55 ;;^DD(58.31,0,"NM","AOU")
+56 ;;=
+57 ;;^DD(58.31,0,"UP")
+58 ;;=58.3
+59 ;;^DD(58.31,.01,0)
+60 ;;=AOU^MP58.1'X^PSI(58.1,^0;1^S:$D(X) DINUM=X
+61 ;;^DD(58.31,.01,1,0)
+62 ;;=^.1
+63 ;;^DD(58.31,.01,1,1,0)
+64 ;;=58.3^C
+65 ;;^DD(58.31,.01,1,1,1)
+66 ;;=S ^PSI(58.3,"C",$E(X,1,30),DA(1),DA)=""
+67 ;;^DD(58.31,.01,1,1,2)
+68 ;;=K ^PSI(58.3,"C",$E(X,1,30),DA(1),DA)
+69 ;;^DD(58.31,.01,3)
+70 ;;=Enter Area of Use for item being backordered.
+71 ;;^DD(58.31,.01,21,0)
+72 ;;=^^2^2^2890906^^^^
+73 ;;^DD(58.31,.01,21,1,0)
+74 ;;=This contains the name of the Area of Use for which the item is being
+75 ;;^DD(58.31,.01,21,2,0)
+76 ;;=backordered.
+77 ;;^DD(58.31,.01,"DT")
+78 ;;=2900213
+79 ;;^DD(58.31,1,0)
+80 ;;=DATE/TIME FOR BACKORDER^58.32D^^1;0
+81 ;;^DD(58.31,1,21,0)
+82 ;;=^^1^1^2841220^^
+83 ;;^DD(58.31,1,21,1,0)
+84 ;;= Enter the inventory date/time for the item being backordered.
+85 ;;^DD(58.32,0)
+86 ;;=DATE/TIME FOR BACKORDER SUB-FIELD^NL^4^5
+87 ;;^DD(58.32,0,"NM","DATE/TIME FOR BACKORDER")
+88 ;;=
+89 ;;^DD(58.32,0,"UP")
+90 ;;=58.31
+91 ;;^DD(58.32,.01,0)
+92 ;;=DATE/TIME FOR BACKORDER^D^^0;1^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X
+93 ;;^DD(58.32,.01,1,0)
+94 ;;=^.1
+95 ;;^DD(58.32,.01,1,1,0)
+96 ;;=58.3^D
+97 ;;^DD(58.32,.01,1,1,1)
+98 ;;=S ^PSI(58.3,"D",$E(X,1,30),DA(2),DA(1),DA)=""
+99 ;;^DD(58.32,.01,1,1,2)
+100 ;;=K ^PSI(58.3,"D",$E(X,1,30),DA(2),DA(1),DA)
+101 ;;^DD(58.32,.01,3)
+102 ;;=Enter DATE/TIME for this backorder.
+103 ;;^DD(58.32,.01,21,0)
+104 ;;=^^1^1^2881129^^^^
+105 ;;^DD(58.32,.01,21,1,0)
+106 ;;=This contains the backorder date/time for the item being backordered.
+107 ;;^DD(58.32,.01,"DT")
+108 ;;=2881129
+109 ;;^DD(58.32,1,0)
+110 ;;=CURRENT BACKORDER^NJ6,0^^0;2^K:+X'=X!(X>999999)!(X<0)!(X?.E1"."1N.N) X
+111 ;;^DD(58.32,1,1,0)
+112 ;;=^.1
+113 ;;^DD(58.32,1,1,1,0)
+114 ;;=^^TRIGGER^58.32^2
+115 ;;^DD(58.32,1,1,1,1)
+116 ;;=X ^DD(58.32,1,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^PSI(58.3,D0,1,D1,1,D2,0)):^(0),1:"") S X=$P(Y(1),U,3) S DIU=X K Y S X=DIV S X=DIV X ^DD(58.32,1,1,1,1.4)
+117 ;;^DD(58.32,1,1,1,1.3)
+118 ;;=K DIV S DIV=X,D0=DA(2),DIV(0)=D0,D1=DA(1),DIV(1)=D1,D2=DA,DIV(2)=D2 S Y(0)=X S Y(1)=$S($D(^PSI(58.3,D0,1,D1,1,D2,0)):^(0),1:"") S X=$P(Y(1),U,3)=""
+119 ;;^DD(58.32,1,1,1,1.4)
+120 ;;=S DIH=$S($D(^PSI(58.3,DIV(0),1,DIV(1),1,DIV(2),0)):^(0),1:""),DIV=X X "F %=0:0 Q:$L($P(DIH,U,2,99)) S DIH=DIH_U" S %=$P(DIH,U,4,999),DIU=$P(DIH,U,3),^(0)=$P(DIH,U,1,2)_U_DIV_$S(%]"":U_%,1:""),DIH=58.32,DIG=2 D ^DICR:$N(^DD(DIH,DIG,1,0))>0
+121 ;;^DD(58.32,1,1,1,2)
+122 ;;=Q
+123 ;;^DD(58.32,1,1,1,"%D",0)
+124 ;;=^^2^2^2930827^
+125 ;;^DD(58.32,1,1,1,"%D",1,0)
+126 ;;=This cross-reference sets the field ORIGINAL BACKORDER (58.32,2). This
+127 ;;^DD(58.32,1,1,1,"%D",2,0)
+128 ;;=trigger is only executed when a backorder is first entered.
+129 ;;^DD(58.32,1,1,1,"CREATE CONDITION")
+130 ;;=ORIGINAL BACKORDER=""
+131 ;;^DD(58.32,1,1,1,"CREATE VALUE")
+132 ;;=CURRENT BACKORDER
+133 ;;^DD(58.32,1,1,1,"DELETE VALUE")
+134 ;;=NO EFFECT
+135 ;;^DD(58.32,1,1,1,"FIELD")
+136 ;;=ORIGINAL
+137 ;;^DD(58.32,1,3)
+138 ;;=Type a whole number between 0 and 999999
